Quote


1   package kawa.lang;
2   import java.util.*;
3   import gnu.mapping.*;
4   import gnu.expr.*;
5   import gnu.lists.*;
6   import gnu.kawa.reflect.Invoke;
7   import gnu.bytecode.ClassType;
8   import gnu.kawa.lispexpr.LispLanguage;
9   import gnu.kawa.functions.GetNamedPart;
10  
11  /**
12   * The Syntax transformer that re-writes the "quote" "quasiquote" primitive.
13   * In both cases recursively resolves SyntaxForm wrappers and resolves
14   * namespaces of symbols.  In the case of quasiquote also handles unquoting.
15   * @author  Per Bothner
16   */
17  
18  public class Quote extends Syntax
19  {
20    public static final Quote plainQuote = new Quote("quote", false);
21    public static final Quote quasiQuote = new Quote("quasiquote", true);
22  
23    public Quote (String   name, boolean isQuasi)
24    {
25      super(name);
26      this.isQuasi = isQuasi;
27    }
28  
29    /** An initial value for 'depth' for plain (non-quasi) quote. */
30    protected static final int QUOTE_DEPTH = -1;
31  
32    /** True for quasiquote; false for plain quote. */
33    protected boolean isQuasi;
34  
35    protected Object   expand (Object   template, int depth, Translator tr)
36    {
37      /* #ifdef use:java.util.IdentityHashMap */ 
38      IdentityHashMap seen = new IdentityHashMap();
39      /* #else */
40      // Object seen = null;
41      /* #endif */
42      return expand(template, depth, null, seen, tr);
43    }
44  
45    /** Quote an object (without namespace-expansion).
46     * Basically just recursively removes SyntaxForm wrappers. */
47    public static Object   quote (Object   obj, Translator tr)
48    {
49      return plainQuote.expand(obj, QUOTE_DEPTH, tr);
50    }
51  
52    /** Quote an object (without namespace-expansion).
53     * Basically just recursively removes SyntaxForm wrappers. */
54    public static Object   quote (Object   obj)
55    {
56      return plainQuote.expand(obj, QUOTE_DEPTH, (Translator) Compilation.getCurrent());
57    }
58  
59    protected Expression coerceExpression (Object   val, Translator tr)
60    {
61      return val instanceof Expression ? (Expression) val : leaf(val, tr);
62    }
63  
64    protected Expression leaf (Object   val, Translator tr)
65    {
66      return new QuoteExp(val);
67    }
68  
69    protected boolean expandColonForms ()
70    {
71      return true;
72    }
73  
74    Object   expand_pair (Pair list, int depth, SyntaxForm syntax,
75                        Object   seen, Translator tr)
76    {
77      Pair pair = list;
78      Object   cdr;
79      Object   rest;
80      for (;;)
81        {
82          // This would be simpler as plain recursion, but we try to iterate
83          // over the given list, partly for speed, but more importantly
84          // to avoid stack overflow in the case of long lists.
85          rest = pair;
86          Pair p1, p2;
87          // We're currently examining pair, which is the n'th cdr of list.
88          // All previous elements (cars) are returned identically by expand.
89          // What makes things complicated is that to the extent that no changes
90          // are needed, we want to return the input list as-is.
91          if (expandColonForms()
92              && tr.matches(pair.car, syntax, LispLanguage.lookup_sym)
93              && pair.cdr instanceof Pair
94              && (p1 = (Pair) pair.cdr) instanceof Pair
95              && (p2 = (Pair) p1.cdr) instanceof Pair
96              && p2.cdr == LList.Empty)
97            {
98              Expression part1 = tr.rewrite_car(p1, false);
99              Expression part2 = tr.rewrite_car(p2, false);
100             Symbol sym = tr.namespaceResolve(part1, part2);
101             String   combinedName;
102             if (sym != null)
103               ;
104             else if (part1 instanceof ReferenceExp
105                      && part2 instanceof QuoteExp)
106               sym = tr.getGlobalEnvironment().getSymbol(((ReferenceExp) part1).getName() + ':' + ((QuoteExp) part2).getValue().toString());
107             else if ((combinedName = GetNamedPart.combineName(part1, part2)) != null)
108               sym = tr.getGlobalEnvironment().getSymbol(combinedName);
109             else
110               {
111                 Object   save = tr.pushPositionOf(pair);
112                 tr.error('e', "'"+p1.car+"' is not a valid prefix");
113                 tr.popPositionOf(save);
114               }
115             cdr = sym;
116             break;
117           }
118         else if (depth < 0)
119           {
120           }
121         else if (tr.matches(pair.car, syntax, LispLanguage.quasiquote_sym))
122           depth++;
123         else if (tr.matches(pair.car, syntax, LispLanguage.unquote_sym))
124           {
125             depth--;
126             Pair pair_cdr;
127             if (! (pair.cdr instanceof Pair)
128                 || (pair_cdr = (Pair) pair.cdr).cdr != LList.Empty)
129               return tr.syntaxError ("invalid used of " + pair.car +
130                      " in quasiquote template");
131             if (depth == 0)
132               {
133                 cdr = tr.rewrite_car(pair_cdr, syntax);
134                 break;
135               }
136           }
137         else if (tr.matches(pair.car, syntax, LispLanguage.unquotesplicing_sym))
138           return tr.syntaxError ("invalid used of " + pair.car +
139                  " in quasiquote template");
140         if (depth == 1 && pair.car instanceof Pair)
141           {
142             Object   form = pair.car;
143             SyntaxForm subsyntax = syntax;
144             while (form instanceof SyntaxForm)
145               {
146                 subsyntax = (SyntaxForm) form;
147                 form = subsyntax.form;
148               }
149             int splicing = -1;
150             if (form instanceof Pair)
151               {
152                 Object   op = ((Pair) form).car;
153                 if (tr.matches(op, subsyntax, LispLanguage.unquote_sym))
154                   splicing = 0;
155                 else if (tr.matches(op, subsyntax, LispLanguage.unquotesplicing_sym))
156                   splicing = 1;
157               }
158             if (splicing >= 0)
159               {
160                 form = ((Pair) form).cdr; // skip "unquote[splicing]".
161                 Vector vec = new Vector();
162                 cdr = null;
163                 // R5RS allows only a single argument.  But
164                 // see Bawden: Quasiquotation in Lisp (1999), Appendix B.
165                 for (;;)
166                   {
167                     if (form instanceof SyntaxForm)
168                       {
169                         subsyntax = (SyntaxForm) form;
170                         form = subsyntax.form;
171                       }
172                     if (form == LList.Empty)
173                       break;
174                     if (form instanceof Pair)
175                       {
176                         vec.addElement(tr.rewrite_car((Pair) form, subsyntax));
177                         form = ((Pair) form).cdr;
178                       }
179                     else
180                       return tr.syntaxError("improper list argument to unquote");
181                   }
182                 int nargs = vec.size() + 1;
183                 cdr = expand(pair.cdr, 1, syntax, seen, tr);
184                 if (nargs > 1)
185                   {
186                     Expression[] args = new Expression[nargs];
187                     vec.copyInto(args);
188                     args[nargs-1] = coerceExpression(cdr, tr);
189                     String   method = splicing == 0 ? "consX" : "append";
190                     cdr = Invoke.makeInvokeStatic(quoteType, method, args);
191                   }
192                 rest = pair;
193                 break;
194               }
195           }
196         Object   car = expand (pair.car, depth, syntax, seen, tr);
197         if (car == pair.car)
198           {
199             rest = pair.cdr;
200             if (rest instanceof Pair)
201               {
202                 pair = (Pair) rest;
203                 continue;
204               }
205             cdr = expand(rest, depth, syntax, seen, tr);
206             break;
207           }
208         cdr = expand (pair.cdr, depth, syntax, seen, tr);
209         if (car instanceof Expression || cdr instanceof Expression)
210           {
211             Expression[] args = new Expression[2];
212             args[0] = coerceExpression(car, tr);
213             args[1] = coerceExpression(cdr, tr);
214             cdr = Invoke.makeInvokeStatic(Compilation.typePair, "make", args);
215           }
216         else
217           cdr = Translator.makePair(pair, car, cdr);
218         break;
219       }
220     // rest is the n'th cdr of list.  cdr is the expansion of rest.
221     // The first n cars of list are returned identically by expand.
222     // These do need to be copied because cdr!=rest.
223     if (list == rest)
224       return cdr;
225     Pair p = list;
226     Pair prev = null;
227     for (;;)
228       {
229         Pair q = Translator.makePair(p, p.car, null);
230         if (prev == null)
231           list = q;
232         else
233           prev.cdr = q;
234         prev = q;
235         if (p.cdr == rest)
236           break;
237         p = (Pair) p.cdr;
238       }
239     if (cdr instanceof Expression)
240       {
241         Expression[] args = new Expression[2];
242         args[1] = (Expression) cdr;
243         if (prev == list)
244           {
245             // The n==1 case: Only a single pair before rest.
246             args[0] = leaf(list.car, tr);
247         return Invoke.makeInvokeStatic(Compilation.typePair, "make", args);
248           }
249         else
250           {
251             prev.cdr = LList.Empty;
252             args[0] = leaf(list, tr);
253         return Invoke.makeInvokeStatic(quoteType, "append", args);
254           }
255       }
256     else
257       {
258         prev.cdr = cdr;
259       }
260     return list;
261   }
262 
263   private static final Object   WORKING = new String  ("(working)");
264   private static final Object   CYCLE = new String  ("(cycle)");
265 
266   /** Backquote-expand a template.
267    * @param template the quasiquoted template to expand
268    * @param depth - the (net) number of quasiquotes we are inside.
269    *   The value QUOTE_DEPTH is a special case when we're inside
270    *   a quote rather than a quasiquote.
271    * @param tr the rewrite context
272    * @return the expanded Expression (the result can be a non-expression,
273    *   in which case it is implicitly a QuoteExp).
274    */
275   Object   expand (Object   template, int depth,
276             SyntaxForm syntax, Object   seen, Translator tr)
277   {
278     /* #ifdef use:java.util.IdentityHashMap */ 
279     IdentityHashMap map = (IdentityHashMap) seen;
280     Object   old = map.get(template);
281     if (old == WORKING)
282       {
283         map.put(template, CYCLE);
284         return old;
285       }
286     else if (old == CYCLE)
287       {
288         return old;
289       }
290     else if (old != null)
291       return old;
292     /* #endif */
293     Object   result;
294     if (template instanceof Pair)
295       result = expand_pair ((Pair) template, depth, syntax, seen, tr);
296     else if (template instanceof SyntaxForm)
297       {
298     syntax = (SyntaxForm) template;
299     result = expand(syntax.form, depth, syntax, seen, tr);
300       }
301     else if (template instanceof FVector)
302       {
303     FVector vector = (FVector) template;
304     int n = vector.size();
305     Object  [] buffer = new Object  [n];
306     // For each element, the state is one of these four:
307     // 0: the expanded element is the same as the original
308     // 1: the expanded element is a constant
309     // 2: the expanded element is neither constant nor a slice
310     // 3: the element is sliced in
311     byte[] state = new byte[n];
312     byte max_state = 0;
313     for (int i = 0;  i < n; i++)
314       {
315         Object   element = vector.get(i);
316         int element_depth = depth;
317         Pair pair;
318         if (element instanceof Pair && depth > QUOTE_DEPTH
319         && tr.matches((pair = (Pair)element).car, syntax,
320                   LispLanguage.unquotesplicing_sym)
321         && --element_depth == 0)
322           {
323         Pair pair_cdr;
324         if (! (pair.cdr instanceof Pair)
325             || (pair_cdr = (Pair) pair.cdr).cdr != LList.Empty)
326           return tr.syntaxError ("invalid used of " + pair.car +
327                          " in quasiquote template");
328         buffer[i] = tr.rewrite_car(pair_cdr, syntax);
329         state[i] = 3;
330           }
331         else
332           {
333         buffer [i] = expand (element, element_depth, syntax, seen, tr);
334         if (buffer[i] == element)
335           state[i] = 0;
336         else if (buffer[i] instanceof Expression)
337           state[i] = 2;
338         else
339           state[i] = 1;
340           }
341         if (state[i] > max_state)
342           max_state = state[i];
343       }
344     if (max_state == 0)
345       result = vector;
346     else if (max_state == 1)
347       result = new FVector (buffer);
348     else
349       {
350         Expression[] args = new Expression[n];
351         for (int i = 0;  i < n;  i++)
352           {
353         if (state[i] == 3)
354           args[i] = (Expression) buffer[i];
355         else if (max_state < 3)
356           args[i] = coerceExpression (buffer[i], tr);
357         else if (state[i] < 2)
358           {
359             Object  [] arg1 = new Object  [1];
360             arg1[0] = buffer[i];
361             args[i] = leaf(new FVector (arg1), tr);
362           }
363         else
364           {
365             Expression[] arg1 = new Expression[1];
366             arg1[0] = (Expression) buffer[i];
367             args[i] = Invoke.makeInvokeStatic(vectorType, "vector", arg1);
368           }
369           }
370         if (max_state < 3)
371           result = Invoke.makeInvokeStatic(vectorType, "vector", args);
372         else
373           result = Invoke.makeInvokeStatic(vectorAppendType, "apply", args);
374       }
375       }
376     else
377       result = template;
378     /* #ifdef use:java.util.IdentityHashMap */ 
379     if (template != result && map.get(template) == CYCLE)
380       tr.error('e', "cycle in non-literal data");
381     map.put(template, result);
382     /* #endif */
383     return result;
384   }
385 
386   public Expression rewrite (Object   obj, Translator tr)
387   {
388     Pair pair;
389     if (! (obj instanceof Pair)
390     || (pair = (Pair) obj).cdr != LList.Empty)
391       return tr.syntaxError ("wrong number of arguments to quote");
392     return coerceExpression(expand(pair.car, isQuasi ? 1 : QUOTE_DEPTH, tr), tr);
393   }
394 
395   /** A wrapper around LList.consX to make it a "variable-arg method". */
396   public static Object   consX$V (Object  [] args)
397   {
398     return LList.consX(args);
399   }
400 
401   /** Same as regular append, but handle SyntaxForm wrappers. */
402   public static Object   append$V (Object  [] args)
403   {
404     int count = args.length;
405     if (count == 0)
406       return LList.Empty;
407     Object   result = args[count - 1];
408     for (int i = count - 1; --i >= 0; )
409       {
410     Object   list = args[i];
411     Object   copy = null;
412     Pair last = null;
413         SyntaxForm syntax = null;
414         for (;;)
415       {
416             while (list instanceof SyntaxForm)
417               {
418                 syntax = (SyntaxForm) list;
419                 list = syntax.form;
420               }
421             if (list == LList.Empty)
422               break;
423         Pair list_pair = (Pair) list;
424             Object   car = list_pair.car;
425             if (syntax != null && ! (car instanceof SyntaxForm))
426               car = SyntaxForm.make(car, syntax.scope);
427         Pair new_pair = new Pair(car, null);
428         if (last == null)
429           copy = new_pair;
430         else
431           last.cdr = new_pair;
432         last = new_pair;
433         list = list_pair.cdr;
434       }
435     if (last != null)
436       {
437         last.cdr = result;
438         result = copy;
439       }
440       }
441     return result;
442   }
443 
444   static final ClassType vectorType = ClassType.make("kawa.lib.vectors");
445   static final ClassType vectorAppendType
446     = ClassType.make("kawa.standard.vector_append");
447   static final ClassType quoteType = ClassType.make("kawa.lang.Quote");
448 }
449
A to Z: JavaDoc & Examples Daily Java News & Articles Open Source Projects Open Source Codes Free Computer Books Remove Frame
Popular Tags