1
2 /******************************************************************************
3 * MODULE : evaluate_textual.cpp
4 * DESCRIPTION: operations on text (strings, tuples and trees)
5 * COPYRIGHT : (C) 2006 Joris van der Hoeven
6 *******************************************************************************
7 * This software falls under the GNU general public license version 3 or later.
8 * It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
9 * in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
10 ******************************************************************************/
11
12 #include "evaluate_main.hpp"
13 #include "analyze.hpp"
14 #include "vars.hpp"
15 #include "language.hpp"
16 #include "gui.hpp"
17 #include "file.hpp"
18 #include "dictionary.hpp"
19
20 /******************************************************************************
21 * Array-like operations on strings and compound structures
22 ******************************************************************************/
23
24 tree
evaluate_merge(tree t)25 evaluate_merge (tree t) {
26 int i, n= N(t);
27 if (n == 0) return "";
28 tree acc= evaluate (t[0]);
29 if (is_concat (acc)) acc= tree_as_string (acc);
30 for (i=1; i<n; i++) {
31 tree add= evaluate (t[i]);
32 if (is_atomic (acc) && (is_atomic (add) || is_concat (add)))
33 acc= acc->label * tree_as_string (add);
34 else if (is_tuple (acc) && is_tuple (add))
35 acc= acc * add;
36 else if (is_func (acc, MACRO) && is_func (add, MACRO) &&
37 (N(acc) == N(add)) &&
38 (acc (0, N(acc)-1) == add (0, N(add)-1)))
39 {
40 tree r = copy (acc);
41 tree u1= copy (acc[N(acc)-1]);
42 tree u2= copy (add[N(add)-1]);
43 tree u (CONCAT, u1, u2);
44 if (u1 == "") u= u2;
45 else if (u2 == "") u= u1;
46 else if (is_atomic (u1) && is_atomic (u2))
47 u= u1->label * u2->label;
48 r[N(r)-1]= u;
49 acc= r;
50 }
51 else return evaluate_error ("bad merge");
52 }
53 return acc;
54 }
55
56 tree
evaluate_length(tree t)57 evaluate_length (tree t) {
58 if (N(t)!=1) return evaluate_error ("bad length");
59 tree t1= evaluate (t[0]);
60 if (is_compound (t1)) {
61 if (is_tuple (t1)) return as_string (N (t1));
62 return evaluate_error ("bad length");
63 }
64 return as_string (N (t1->label));
65 }
66
67 tree
evaluate_range(tree t)68 evaluate_range (tree t) {
69 if (N(t)!=3) return evaluate_error ("bad range");
70 tree t1= evaluate (t[0]);
71 tree t2= evaluate (t[1]);
72 tree t3= evaluate (t[2]);
73 if (!(is_int (t2) && is_int (t3))) return evaluate_error ("bad range");
74 if (is_compound (t1)) {
75 if (is_tuple (t1)) {
76 int i1= max (0, as_int (t2));
77 int i2= min (N (t1), as_int (t3));
78 i2 = max (i1, i2);
79 return t1 (i1, i2);
80 }
81 return evaluate_error ("bad range");
82 }
83 int i1= max (0, as_int (t2));
84 int i2= min (N(t1->label), as_int (t3));
85 i2 = max (i1, i2);
86 return t1->label (i1, i2);
87 }
88
89 /******************************************************************************
90 * Routines on strings
91 ******************************************************************************/
92
93 tree
evaluate_number(tree t)94 evaluate_number (tree t) {
95 if (N(t)!=2) return evaluate_error ("bad number");
96 tree t1= evaluate (t[0]);
97 tree t2= evaluate (t[1]);
98 if (is_compound (t1) || is_compound (t2))
99 return evaluate_error ("bad number");
100 string s1= t1->label;
101 string s2= t2->label;
102 int nr= as_int (s1);
103 if (s2 == "arabic") return as_string (nr);
104 if (s2 == "roman") return roman_nr (nr);
105 if (s2 == "Roman") return Roman_nr (nr);
106 if (s2 == "alpha") return alpha_nr (nr);
107 if (s2 == "Alpha") return Alpha_nr (nr);
108 if (s2 == "fnsymbol")
109 return tree (WITH, MODE, "math", tree (RIGID, fnsymbol_nr (nr)));
110 return evaluate_error ("bad number");
111 }
112
113 tree
evaluate_date(tree t)114 evaluate_date (tree t) {
115 if (N(t)>2) return evaluate_error ("bad date");
116 string lan= as_string (std_env [LANGUAGE]);
117 if (N(t) == 2) {
118 tree u= evaluate (t[1]);
119 if (is_compound (u)) return evaluate_error ("bad date");
120 lan= u->label;
121 }
122 string fm= "";
123 if (N(t) != 0) {
124 tree u= evaluate (t[0]);
125 if (is_compound (u)) return evaluate_error ("bad date");
126 fm= u->label;
127 }
128 return get_date (lan, fm);
129 }
130
131 tree
evaluate_translate(tree t)132 evaluate_translate (tree t) {
133 if (N(t)!=3) return evaluate_error ("bad translate");
134 tree t1= evaluate (t[0]);
135 tree t2= evaluate (t[1]);
136 tree t3= evaluate (t[2]);
137 if (is_compound (t1) || is_compound (t2) || is_compound (t3))
138 return evaluate_error ("bad translate");
139 return translate (t1->label, t2->label, t3->label);
140 }
141
142 tree
evaluate_change_case(tree t,tree nc,bool evaluate_flag,bool first)143 evaluate_change_case (tree t, tree nc, bool evaluate_flag, bool first) {
144 if (is_atomic (t)) {
145 string s= t->label;
146 tree r= copy (s);
147 int i, n= N(s);
148
149 bool all= true;
150 bool up = false;
151 bool lo = false;
152 if (nc == "Upcase") { all= false; up= true; }
153 else if (nc == "UPCASE") { up= true; }
154 else if (nc == "locase") { lo= true; }
155
156 for (i=0; i<n; tm_char_forwards (s, i))
157 if (is_iso_alpha (s[i]) && (all || (first && (i==0)))) {
158 if (up && is_locase (s[i])) r->label[i]= upcase (s[i]);
159 if (lo && is_upcase (s[i])) r->label[i]= locase (s[i]);
160 }
161 r->obs= list_observer (ip_observer (obtain_ip (t)), r->obs);
162 return r;
163 }
164 else if (is_concat (t)) {
165 int i, n= N(t);
166 tree r (t, n);
167 for (i=0; i<n; i++)
168 r[i]= evaluate_change_case (t[i], nc, evaluate_flag, first && (i==0));
169 r->obs= list_observer (ip_observer (obtain_ip (t)), r->obs);
170 return r;
171 }
172 else {
173 if (evaluate_flag) return t;
174 else return evaluate_change_case (evaluate (t), nc, true, first);
175 }
176 }
177
178 tree
evaluate_change_case(tree t)179 evaluate_change_case (tree t) {
180 if (N(t) < 2) return evaluate_error ("bad change case");
181 return evaluate_change_case (t[0], evaluate (t[1]), false, true);
182 }
183
184 tree
evaluate_find_file(tree t)185 evaluate_find_file (tree t) {
186 int i, n=N(t);
187 array<tree> r (n);
188 for (i=0; i<n; i++) {
189 r[i]= evaluate (t[i]);
190 if (is_compound (r[i]))
191 return evaluate_error ("bad find file");
192 }
193 for (i=0; i<(n-1); i++) {
194 url u= resolve (url (r[i]->label, r[n-1]->label));
195 if (!is_none (u)) {
196 if (is_rooted (u, "default")) u= reroot (u, "file");
197 return as_string (u);
198 }
199 }
200 url base_file_name (as_string (std_env["base-file-name"]));
201 url u= resolve (base_file_name * url_parent () * r[n-1]->label);
202 if (!is_none (u)) {
203 if (is_rooted (u, "default")) u= reroot (u, "file");
204 return as_string (u);
205 }
206 return "false";
207 }
208
209 /******************************************************************************
210 * Routines on tuples
211 ******************************************************************************/
212
213 tree
evaluate_is_tuple(tree t)214 evaluate_is_tuple (tree t) {
215 if (N(t)!=1) return evaluate_error ("bad tuple query");
216 return as_string_bool(is_tuple (evaluate (t[0])));
217 }
218
219 tree
evaluate_lookup(tree t)220 evaluate_lookup (tree t) {
221 if (N(t)!=2) return evaluate_error ("bad look up");
222 tree t1= evaluate (t[0]);
223 tree t2= evaluate (t[1]);
224 if (!(is_compound (t1) && is_int (t2)))
225 return evaluate_error ("bad look up");
226 int i= as_int (t2);
227 if (i < 0 || i >= N(t1))
228 return evaluate_error ("index out of range in look up");
229 return t1[i];
230 }
231