2
/******************************************************************************
3
* MODULE : evaluate_inactive.cpp
4
* DESCRIPTION: generate source code representations for inactive 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
******************************************************************************/
12
#include "evaluate_main.hpp"
13
#include "memorizer.hpp"
14
#include "std_environment.hpp"
17
/******************************************************************************
18
* Some trees need to be defined only once (ensuring a fixed address)
19
******************************************************************************/
21
static tree psep_var ("par-par-sep");
22
static tree psep_0fn ("0fn");
23
static tree mode_var ("mode");
24
static tree mode_src ("src");
25
static tree surround1 ("");
26
static tree surround2 (VSPACE, "0.5fn");
28
/******************************************************************************
30
******************************************************************************/
32
bool is_long_arg (tree t, int i);
33
bool is_long (tree t);
34
string arg_type (tree t, int i);
37
highlight (tree t, string kind) {
38
if (is_compound (t)) return t;
39
else if (kind == "") return t;
40
else if (kind == "macro") return compound ("src-macro", t);
41
else if (kind == "var") return compound ("src-var", t);
42
else if (kind == "arg") return compound ("src-arg", t);
43
else if (kind == "tt") return compound ("src-tt", t);
44
else if (kind == "integer") return compound ("src-integer", t);
45
else if (kind == "length") return compound ("src-length", t);
46
else if (kind == "error") return compound ("src-error", t);
51
tree rewrite_inactive (tree t, inactive_style sty);
52
tree rewrite_inactive_default (tree t, inactive_style sty);
54
/******************************************************************************
55
* Values for inactive style parameters
56
******************************************************************************/
58
#define STYLE_ANGULAR 0
59
#define STYLE_SCHEME 1
61
#define STYLE_FUNCTIONAL 3
64
#define SPECIAL_FORMAT 1
65
#define SPECIAL_NORMAL 2
66
#define SPECIAL_MAXIMAL 3
69
#define COMPACT_INLINE_ARGS 1
70
#define COMPACT_INLINE_START 2
71
#define COMPACT_INLINE 3
72
#define COMPACT_NONE 4
74
#define CLOSE_MINIMAL 0
75
#define CLOSE_COMPACT 1
77
#define CLOSE_REPEAT 3
79
/******************************************************************************
80
* Inactive style parameters
81
******************************************************************************/
83
struct inactive_style_rep {
94
class inactive_style {
97
inline inactive_style (): rep (0) {}
98
inline inactive_style (const inactive_style& sty): rep (sty.rep) {}
99
inline inactive_style& operator = (const inactive_style& sty) {
100
rep= sty.rep; return *this; }
101
inline inactive_style_rep* operator -> () {
102
return (inactive_style_rep*) ((void*) &rep); }
103
inline bool operator == (inactive_style sty) { return rep == sty.rep; }
104
inline bool operator != (inactive_style sty) { return rep != sty.rep; }
105
inline friend int hash (inactive_style sty) { return sty.rep; }
108
inline inactive_style set_bf (inactive_style sty, bool block, bool flush) {
109
inactive_style new_sty= sty;
110
new_sty->block= block;
111
new_sty->flush= flush;
114
inline inactive_style reset_bf (inactive_style sty) {
115
inactive_style new_sty= sty;
122
retrieve (environment env) {
126
s= as_string (env [SRC_STYLE]);
127
if (s == "angular") sty->style= STYLE_ANGULAR;
128
else if (s == "scheme") sty->style= STYLE_SCHEME;
129
else if (s == "latex") sty->style= STYLE_LATEX;
130
else if (s == "functional") sty->style= STYLE_FUNCTIONAL;
131
else sty->style= STYLE_ANGULAR;
133
s= as_string (env [SRC_SPECIAL]);
134
if (s == "raw") sty->special= SPECIAL_RAW;
135
else if (s == "format") sty->special= SPECIAL_FORMAT;
136
else if (s == "normal") sty->special= SPECIAL_NORMAL;
137
else if (s == "maximal") sty->special= SPECIAL_MAXIMAL;
138
else sty->special= SPECIAL_NORMAL;
140
s= as_string (env [SRC_COMPACT]);
141
if (s == "all") sty->compact= COMPACT_ALL;
142
else if (s == "inline args") sty->compact= COMPACT_INLINE_ARGS;
143
else if (s == "normal") sty->compact= COMPACT_INLINE_START;
144
else if (s == "inline") sty->compact= COMPACT_INLINE;
145
else if (s == "none") sty->compact= COMPACT_NONE;
146
else sty->compact= COMPACT_INLINE_START;
148
s= as_string (env [SRC_CLOSE]);
149
if (s == "minimal") sty->close= CLOSE_MINIMAL;
150
else if (s == "compact") sty->close= CLOSE_COMPACT;
151
else if (s == "long") sty->close= CLOSE_LONG;
152
else if (s == "repeat") sty->close= CLOSE_REPEAT;
153
else sty->close= CLOSE_COMPACT;
158
/******************************************************************************
159
* Memorizing rewritings
160
******************************************************************************/
162
static tree no_tree (UNINIT);
165
class inactive_memorizer_rep: public compound_memorizer_rep {
168
inactive_style sty_in;
173
inline inactive_memorizer_rep (environment env, tree t, inactive_style sty):
174
env_in (env), t_in (t), sty_in (sty), env_out (), t_out (no_tree) {}
175
void print (ostream& out) {
176
out << "inactive_memorizer (" << t_in << ")"; }
178
int type () { return MEMORIZE_INACTIVE; }
180
return weak_hash (env_in) ^ weak_hash (t_in) ^ ::hash (sty_in); }
181
bool equal (memorizer_rep* mem) {
182
inactive_memorizer_rep* rep= (inactive_memorizer_rep*) mem;
184
weak_equal (env_in, rep->env_in) &&
185
weak_equal (t_in, rep->t_in) &&
186
sty_in == rep->sty_in; }
188
void set_environment (environment env) { env_out= env; }
189
environment get_environment () { return env_out; }
190
void set_tree (tree t) { t_out= t; }
191
tree get_tree () { return t_out; }
195
inactive_memorizer (environment env, tree t, inactive_style sty) {
196
return (memorizer_rep*) tm_new<inactive_memorizer_rep> (env, t, sty);
199
/******************************************************************************
200
* Compute rendering of inactive markup
201
******************************************************************************/
204
rewrite_inactive_arg (tree t, int i, inactive_style sty) {
206
if ((sty->mode == INACTIVE_INLINE_RECURSE) ||
207
(sty->mode == INACTIVE_BLOCK_RECURSE))
210
if (N (recover_env) > 0) {
212
tree recover= copy (recover_env), old_recover= recover_env;
213
for (j=0; j<N(recover); j+=2) {
214
string var= recover[j]->label;
215
recover[j+1]= read (var);
216
write_update (var, recover_env[j+1]);
218
recover_env= tuple ();
219
r= rewrite_inactive (r, sty);
220
recover_env= old_recover;
221
for (j=0; j<N(recover); j+=2)
222
write_update (recover[j]->label, recover[j+1]);
226
r= rewrite_inactive (r, sty);
228
return highlight (r, arg_type (t, i));
232
rewrite_inactive_raw_data (tree t, inactive_style sty) {
233
return rewrite_inactive_default (tree (RAW_DATA), sty);
237
rewrite_inactive_document (tree t, inactive_style sty) {
238
if ((sty->block || (sty->compact == COMPACT_NONE)) &&
239
(sty->special > SPECIAL_RAW) &&
240
(sty->compact != COMPACT_ALL))
243
tree r (DOCUMENT, n);
244
for (i=0; i<n; i++) {
245
inactive_style ss= set_bf (sty, true, sty->flush || (i<n-1));
246
r[i]= rewrite_inactive_arg (t, i, ss);
250
return rewrite_inactive_default (t, sty);
254
rewrite_inactive_concat (tree t, inactive_style sty) {
255
if ((sty->special > SPECIAL_RAW) && (sty->compact != COMPACT_NONE)) {
259
r[i]= rewrite_inactive_arg (t, i, reset_bf (sty));
262
return rewrite_inactive_default (t, sty);
266
rewrite_inactive_value (tree t, inactive_style sty) {
267
if ((N(t) == 1) && is_atomic (t[0]) &&
268
sty->style != STYLE_SCHEME && sty->special >= SPECIAL_NORMAL)
269
return highlight (t[0],
270
sty->mode == INACTIVE_INLINE_ERROR ||
271
sty->mode == INACTIVE_BLOCK_ERROR ?
272
string ("error"): string ("var"));
273
return rewrite_inactive_default (t, sty);
277
rewrite_inactive_arg (tree t, inactive_style sty) {
278
if ((N(t) == 1) && is_atomic (t[0]) &&
279
sty->style != STYLE_SCHEME && sty->special >= SPECIAL_NORMAL)
280
return highlight (t[0],
281
sty->mode == INACTIVE_INLINE_ERROR ||
282
sty->mode == INACTIVE_BLOCK_ERROR ?
283
string ("error"): string ("arg"));
284
return rewrite_inactive_default (t, sty);
288
rewrite_inactive_symbol (tree t, inactive_style sty) {
289
if ((N(t) == 1) && is_atomic (t[0]) && (sty->special >= SPECIAL_NORMAL))
290
return tree (INLINE_TAG, t[0]);
291
return rewrite_inactive_default (t, sty);
295
rewrite_inactive_style_with (tree t, inactive_style sty, bool once) {
297
tree recover= tuple ();
299
for (i=0; i<n-1; i+=2)
300
if (is_atomic (t[i])) {
301
recover << t[i] << read (t[i]->label);
302
write_update (t[i]->label, t[i+1]);
304
if (once) recover_env= recover;
306
tree r= rewrite_inactive (t[n-1], sty);
308
for (i=0; i<N(recover); i+=2)
309
write_update (recover[i]->label, recover[i+1]);
310
if (once) recover_env= tuple ();
316
rewrite_inactive_active (tree t, inactive_style sty) {
320
bool mp= is_multi_paragraph (st);
321
for (i=0; i<n; i++) {
322
bool smp= mp && is_long_arg (st, i);
323
if (is_func (st, WITH) && (i<n-1)) r[i]= st[i];
325
inactive_style ss= set_bf (sty, sty->block && smp, sty->flush && smp);
326
r[i]= rewrite_inactive_arg (st, i, ss);
333
rewrite_inactive_var_active (tree t, inactive_style sty) {
334
tree r= tree (WITH, mode_var, std_env [MODE], t[0]);
336
(sty->compact != COMPACT_ALL) &&
337
(is_multi_paragraph (t[0])) || (sty->compact == COMPACT_NONE))
338
r= tree (SURROUND, "", compound ("right-flush"), r);
343
rewrite_inactive_hybrid (tree t, inactive_style sty) {
344
if (is_atomic (t[0]) && (sty->special >= SPECIAL_NORMAL)) {
346
tree r (INLINE_TAG, n);
347
r[0]= tree (CONCAT, "\\", highlight (t[0], "var"));
349
r[i]= rewrite_inactive_arg (t, i, reset_bf (sty));
352
return rewrite_inactive_default (t, sty);
356
rewrite_inactive_default (tree t, inactive_style sty) {
357
int i, d= 0, n= N(t);
358
tree op= as_string (L(t));
359
if ((L(t) == COMPOUND) &&
361
(sty->special >= SPECIAL_NORMAL))
364
op= highlight (t[0], "var");
366
if (sty->mode == INACTIVE_INLINE_ERROR ||
367
sty->mode == INACTIVE_BLOCK_ERROR)
368
op= highlight (op, "error");
371
(sty->compact == COMPACT_ALL) ||
372
((!sty->block) && (sty->compact != COMPACT_NONE)) ||
373
(!is_long (t)) && (sty->compact != COMPACT_NONE))
375
tree r (INLINE_TAG, n+1-d);
378
r[i+1-d]= rewrite_inactive_arg (t, i, reset_bf (sty));
383
bool compact= (sty->compact < COMPACT_INLINE);
385
for (i=d; i<n; i++) {
387
if ((!compact) || is_long_arg (t, i)) {
388
if (i==d) doc << tree (OPEN_TAG, op);
389
inactive_style ss= set_bf (sty, true, sty->close >= CLOSE_LONG);
390
next= rewrite_inactive_arg (t, i, ss);
391
next= compound ("indent", next);
397
if ((!compact) || is_long_arg (t, i)) break;
399
tree_label l= MIDDLE_TAG;
400
if (end == n) l= CLOSE_TAG;
401
if (start == d) l= OPEN_TAG;
402
tree u (l, end - start + 1);
404
for (i=0; i<end-start; i++)
405
u[i+1]= rewrite_inactive_arg (t, start+i, reset_bf (sty));
407
compact= (sty->compact < COMPACT_INLINE_START);
409
if (start==d) doc << u;
411
if (sty->close < CLOSE_LONG)
412
doc << tree (SURROUND, "", u, next);
413
else doc << next << u;
417
if (sty->flush) doc= tree (SURROUND, "", compound ("right-flush"), doc);
423
rewrite_inactive_impl (tree t, inactive_style sty) {
426
if (sty->special >= SPECIAL_NORMAL)
427
return highlight ("?", "error");
428
else return rewrite_inactive_default (t, sty);
430
return rewrite_inactive_raw_data (t, sty);
432
return rewrite_inactive_document (t, sty);
434
return rewrite_inactive_concat (t, sty);
436
return rewrite_inactive_value (t, sty);
438
return rewrite_inactive_arg (t, sty);
440
return rewrite_inactive_style_with (t, sty, true);
442
return rewrite_inactive_style_with (t, sty, false);
444
return rewrite_inactive_active (t, sty);
446
return rewrite_inactive_var_active (t, sty);
448
return rewrite_inactive_active (t, sty);
450
return rewrite_inactive_var_active (t, sty);
452
return rewrite_inactive_symbol (t, sty);
454
return rewrite_inactive_hybrid (t, sty);
456
return rewrite_inactive_default (t, sty);
460
/******************************************************************************
461
* Main rewriting routines
462
******************************************************************************/
464
static tree quote1 (WITH, "color", "blue", "``");
465
static tree quote2 (WITH, "color", "blue", "''");
468
rewrite_inactive (tree t, inactive_style sty) {
470
if (sty->style == STYLE_SCHEME)
471
return tree (CONCAT, quote1, t, quote2);
475
<< "[" << (t.operator -> ())
476
<< ", " << (std_env.operator -> ()) << "] "
477
<< t << INDENT << LF;
478
memorizer mem= inactive_memorizer (std_env, t, sty);
479
if (is_memorized (mem)) {
480
cout << UNINDENT << "Memorized " << mem->get_tree () << LF;
481
std_env= mem->get_environment ();
482
return mem->get_tree ();
485
tree r= rewrite_inactive_impl (t, sty);
487
mem->set_environment (std_env);
489
cout << UNINDENT << "Rewritten as " << mem->get_tree () << LF;
490
return mem->get_tree ();
494
rewrite_inactive (tree t, int inactive_mode) {
495
//recover_env= tuple ();
496
inactive_style sty= retrieve (std_env);
497
sty->mode= inactive_mode;
498
bool flag= (sty->mode >= INACTIVE_BLOCK_RECURSE);
499
sty->block= sty->flush= flag;
500
tree r= rewrite_inactive (t, sty);
501
if (is_multi_paragraph (r)) {
502
r= tree (WITH, psep_var, psep_0fn, r);
503
r= tree (SURROUND, surround1, surround2, r);
505
if ((sty->mode == INACTIVE_INLINE_RECURSE) ||
506
(sty->mode == INACTIVE_BLOCK_RECURSE))
507
r= tree (WITH, mode_var, mode_src, r);