~registry/texmacs/trunk

« back to all changes in this revision

Viewing changes to src/src/Style/Evaluate/evaluate_inactive.cpp

  • Committer: mgubi
  • Date: 2009-06-04 15:13:41 UTC
  • Revision ID: svn-v4:64cb5145-927a-446d-8aed-2fb7b4773692:trunk:2717
Support for X11 TeXmacs.app on Mac

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
 
 
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
******************************************************************************/
 
11
 
 
12
#include "evaluate_main.hpp"
 
13
#include "memorizer.hpp"
 
14
#include "std_environment.hpp"
 
15
#include "vars.hpp"
 
16
 
 
17
/******************************************************************************
 
18
* Some trees need to be defined only once (ensuring a fixed address)
 
19
******************************************************************************/
 
20
 
 
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");
 
27
 
 
28
/******************************************************************************
 
29
* Forward definitions
 
30
******************************************************************************/
 
31
 
 
32
bool is_long_arg (tree t, int i);
 
33
bool is_long (tree t);
 
34
string arg_type (tree t, int i);
 
35
 
 
36
tree
 
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);
 
47
  return t;
 
48
}
 
49
 
 
50
class inactive_style;
 
51
tree rewrite_inactive (tree t, inactive_style sty);
 
52
tree rewrite_inactive_default (tree t, inactive_style sty);
 
53
 
 
54
/******************************************************************************
 
55
* Values for inactive style parameters
 
56
******************************************************************************/
 
57
 
 
58
#define STYLE_ANGULAR         0
 
59
#define STYLE_SCHEME          1
 
60
#define STYLE_LATEX           2
 
61
#define STYLE_FUNCTIONAL      3
 
62
 
 
63
#define SPECIAL_RAW           0
 
64
#define SPECIAL_FORMAT        1
 
65
#define SPECIAL_NORMAL        2
 
66
#define SPECIAL_MAXIMAL       3
 
67
 
 
68
#define COMPACT_ALL           0
 
69
#define COMPACT_INLINE_ARGS   1
 
70
#define COMPACT_INLINE_START  2
 
71
#define COMPACT_INLINE        3
 
72
#define COMPACT_NONE          4
 
73
 
 
74
#define CLOSE_MINIMAL         0
 
75
#define CLOSE_COMPACT         1
 
76
#define CLOSE_LONG            2
 
77
#define CLOSE_REPEAT          3
 
78
 
 
79
/******************************************************************************
 
80
* Inactive style parameters
 
81
******************************************************************************/
 
82
 
 
83
struct inactive_style_rep {
 
84
  unsigned style   : 4;
 
85
  unsigned special : 4;
 
86
  unsigned compact : 4;
 
87
  unsigned close   : 4;
 
88
  unsigned mode    : 4;
 
89
  unsigned block   : 1;
 
90
  unsigned flush   : 1;
 
91
  unsigned recover : 1;
 
92
};
 
93
 
 
94
class inactive_style {
 
95
  int rep;
 
96
public:
 
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; }
 
106
};
 
107
 
 
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;
 
112
  return new_sty; }
 
113
 
 
114
inline inactive_style reset_bf (inactive_style sty) {
 
115
  inactive_style new_sty= sty;
 
116
  new_sty->block= 0;
 
117
  new_sty->flush= 0;
 
118
  return new_sty; }
 
119
 
 
120
 
 
121
inactive_style
 
122
retrieve (environment env) {
 
123
  string s;
 
124
  inactive_style sty;
 
125
 
 
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;
 
132
  
 
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;
 
139
 
 
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;
 
147
 
 
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;
 
154
 
 
155
  return sty;
 
156
}
 
157
 
 
158
/******************************************************************************
 
159
* Memorizing rewritings
 
160
******************************************************************************/
 
161
 
 
162
static tree no_tree (UNINIT);
 
163
 
 
164
class memorizer;
 
165
class inactive_memorizer_rep: public compound_memorizer_rep {
 
166
  environment env_in;
 
167
  tree t_in;
 
168
  inactive_style sty_in;
 
169
  environment env_out;
 
170
  tree t_out;
 
171
 
 
172
public:
 
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 << ")"; }
 
177
 
 
178
  int type () { return MEMORIZE_INACTIVE; }
 
179
  int hash () {
 
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;
 
183
    return
 
184
      weak_equal (env_in, rep->env_in) &&
 
185
      weak_equal (t_in, rep->t_in) &&
 
186
      sty_in == rep->sty_in; }
 
187
 
 
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; }
 
192
};
 
193
 
 
194
inline memorizer
 
195
inactive_memorizer (environment env, tree t, inactive_style sty) {
 
196
  return (memorizer_rep*) tm_new<inactive_memorizer_rep> (env, t, sty);
 
197
}
 
198
 
 
199
/******************************************************************************
 
200
* Compute rendering of inactive markup
 
201
******************************************************************************/
 
202
 
 
203
tree
 
204
rewrite_inactive_arg (tree t, int i, inactive_style sty) {
 
205
  tree r= t[i];
 
206
  if ((sty->mode == INACTIVE_INLINE_RECURSE) ||
 
207
      (sty->mode == INACTIVE_BLOCK_RECURSE))
 
208
    {
 
209
      /*
 
210
      if (N (recover_env) > 0) {
 
211
        int j;
 
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]);
 
217
        }
 
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]);
 
223
      }
 
224
      else
 
225
      */
 
226
        r= rewrite_inactive (r, sty);
 
227
    }
 
228
  return highlight (r, arg_type (t, i));
 
229
}
 
230
 
 
231
tree
 
232
rewrite_inactive_raw_data (tree t, inactive_style sty) {
 
233
  return rewrite_inactive_default (tree (RAW_DATA), sty);
 
234
}
 
235
 
 
236
tree
 
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))
 
241
    {
 
242
      int i, n= N(t);
 
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);
 
247
      }
 
248
      return r;
 
249
    }
 
250
  return rewrite_inactive_default (t, sty);
 
251
}
 
252
 
 
253
tree
 
254
rewrite_inactive_concat (tree t, inactive_style sty) {
 
255
  if ((sty->special > SPECIAL_RAW) && (sty->compact != COMPACT_NONE)) {
 
256
    int i, n= N(t);
 
257
    tree r (CONCAT, n);
 
258
    for (i=0; i<n; i++)
 
259
      r[i]= rewrite_inactive_arg (t, i, reset_bf (sty));
 
260
    return r;
 
261
  }
 
262
  return rewrite_inactive_default (t, sty);
 
263
}
 
264
 
 
265
tree
 
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);
 
274
}
 
275
 
 
276
tree
 
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);
 
285
}
 
286
 
 
287
tree
 
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);
 
292
}
 
293
 
 
294
tree
 
295
rewrite_inactive_style_with (tree t, inactive_style sty, bool once) {
 
296
  int /*i,*/ n= N(t);
 
297
  tree recover= tuple ();
 
298
  /*
 
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]);
 
303
    }
 
304
    if (once) recover_env= recover;
 
305
  */
 
306
  tree r= rewrite_inactive (t[n-1], sty);
 
307
  /*
 
308
  for (i=0; i<N(recover); i+=2)
 
309
    write_update (recover[i]->label, recover[i+1]);
 
310
  if (once) recover_env= tuple ();
 
311
  */
 
312
  return r;
 
313
}
 
314
 
 
315
tree
 
316
rewrite_inactive_active (tree t, inactive_style sty) {
 
317
  tree st= t[0];
 
318
  int i, n= N(st);
 
319
  tree r (st, n);
 
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];
 
324
    else {
 
325
      inactive_style ss= set_bf (sty, sty->block && smp, sty->flush && smp);
 
326
      r[i]= rewrite_inactive_arg (st, i, ss);
 
327
    }
 
328
  }
 
329
  return r;
 
330
}
 
331
 
 
332
tree
 
333
rewrite_inactive_var_active (tree t, inactive_style sty) {
 
334
  tree r= tree (WITH, mode_var, std_env [MODE], t[0]);
 
335
  if (sty->flush &&
 
336
      (sty->compact != COMPACT_ALL) &&
 
337
      (is_multi_paragraph (t[0])) || (sty->compact == COMPACT_NONE))
 
338
    r= tree (SURROUND, "", compound ("right-flush"), r);
 
339
  return r;
 
340
}
 
341
 
 
342
tree
 
343
rewrite_inactive_hybrid (tree t, inactive_style sty) {
 
344
  if (is_atomic (t[0]) && (sty->special >= SPECIAL_NORMAL)) {
 
345
    int i, n= N(t);
 
346
    tree r (INLINE_TAG, n);
 
347
    r[0]= tree (CONCAT, "\\", highlight (t[0], "var"));
 
348
    for (i=1; i<n; i++)
 
349
      r[i]= rewrite_inactive_arg (t, i, reset_bf (sty));
 
350
    return r;
 
351
  }
 
352
  return rewrite_inactive_default (t, sty);
 
353
}
 
354
 
 
355
tree
 
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) &&
 
360
      is_atomic (t[0]) &&
 
361
      (sty->special >= SPECIAL_NORMAL))
 
362
    {
 
363
      d = 1;
 
364
      op= highlight (t[0], "var");
 
365
    }
 
366
  if (sty->mode == INACTIVE_INLINE_ERROR ||
 
367
      sty->mode == INACTIVE_BLOCK_ERROR)
 
368
    op= highlight (op, "error");
 
369
 
 
370
  if ((N(t) == d) ||
 
371
      (sty->compact == COMPACT_ALL) ||
 
372
      ((!sty->block) && (sty->compact != COMPACT_NONE)) ||
 
373
      (!is_long (t)) && (sty->compact != COMPACT_NONE))
 
374
    {
 
375
      tree r (INLINE_TAG, n+1-d);
 
376
      r[0]= op;
 
377
      for (i=d; i<n; i++)
 
378
        r[i+1-d]= rewrite_inactive_arg (t, i, reset_bf (sty));
 
379
      return r;
 
380
    }
 
381
  else {
 
382
    tree doc (DOCUMENT);
 
383
    bool compact= (sty->compact < COMPACT_INLINE);
 
384
 
 
385
    for (i=d; i<n; i++) {
 
386
      tree next;
 
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);
 
392
        i++;
 
393
      }
 
394
 
 
395
      int start= i;
 
396
      for (; i<n; i++)
 
397
        if ((!compact) || is_long_arg (t, i)) break;
 
398
      int end= i;
 
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);
 
403
      u[0]= op;
 
404
      for (i=0; i<end-start; i++)
 
405
        u[i+1]= rewrite_inactive_arg (t, start+i, reset_bf (sty));
 
406
      i= end-1;
 
407
      compact= (sty->compact < COMPACT_INLINE_START);
 
408
 
 
409
      if (start==d) doc << u;
 
410
      else {
 
411
        if (sty->close < CLOSE_LONG)
 
412
          doc << tree (SURROUND, "", u, next);
 
413
        else doc << next << u;
 
414
      }
 
415
    }
 
416
 
 
417
    if (sty->flush) doc= tree (SURROUND, "", compound ("right-flush"), doc);
 
418
    return doc;
 
419
  }
 
420
}
 
421
 
 
422
tree
 
423
rewrite_inactive_impl (tree t, inactive_style sty) {
 
424
  switch (L(t)) {
 
425
  case UNINIT:
 
426
    if (sty->special >= SPECIAL_NORMAL)
 
427
      return highlight ("?", "error");
 
428
    else return rewrite_inactive_default (t, sty);
 
429
  case RAW_DATA:
 
430
    return rewrite_inactive_raw_data (t, sty);
 
431
  case DOCUMENT:
 
432
    return rewrite_inactive_document (t, sty);
 
433
  case CONCAT:
 
434
    return rewrite_inactive_concat (t, sty);
 
435
  case VALUE:
 
436
    return rewrite_inactive_value (t, sty);
 
437
  case ARG:
 
438
    return rewrite_inactive_arg (t, sty);
 
439
  case STYLE_WITH:
 
440
    return rewrite_inactive_style_with (t, sty, true);
 
441
  case VAR_STYLE_WITH:
 
442
    return rewrite_inactive_style_with (t, sty, false);
 
443
  case STYLE_ONLY:
 
444
    return rewrite_inactive_active (t, sty);
 
445
  case VAR_STYLE_ONLY:
 
446
    return rewrite_inactive_var_active (t, sty);
 
447
  case ACTIVE:
 
448
    return rewrite_inactive_active (t, sty);
 
449
  case VAR_ACTIVE:
 
450
    return rewrite_inactive_var_active (t, sty);
 
451
  case SYMBOL:
 
452
    return rewrite_inactive_symbol (t, sty);
 
453
  case HYBRID:
 
454
    return rewrite_inactive_hybrid (t, sty);
 
455
  default:
 
456
    return rewrite_inactive_default (t, sty);
 
457
  }
 
458
}
 
459
 
 
460
/******************************************************************************
 
461
* Main rewriting routines
 
462
******************************************************************************/
 
463
 
 
464
static tree quote1 (WITH, "color", "blue", "``");
 
465
static tree quote2 (WITH, "color", "blue", "''");
 
466
 
 
467
tree
 
468
rewrite_inactive (tree t, inactive_style sty) {
 
469
  if (is_atomic (t)) {
 
470
    if (sty->style == STYLE_SCHEME)
 
471
      return tree (CONCAT, quote1, t, quote2);
 
472
    return t;
 
473
  }
 
474
  cout << "Inactive "
 
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 ();
 
483
  }
 
484
  memorize_start ();
 
485
  tree r= rewrite_inactive_impl (t, sty);
 
486
  mem->set_tree (r);
 
487
  mem->set_environment (std_env);
 
488
  memorize_end ();
 
489
  cout << UNINDENT << "Rewritten as " << mem->get_tree () << LF;
 
490
  return mem->get_tree ();
 
491
}
 
492
 
 
493
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);
 
504
  }
 
505
  if ((sty->mode == INACTIVE_INLINE_RECURSE) ||
 
506
      (sty->mode == INACTIVE_BLOCK_RECURSE))
 
507
    r= tree (WITH, mode_var, mode_src, r);
 
508
  return r;
 
509
}