KickJava   Java API By Example, From Geeks To Geeks.

Java > Open Source Codes > kawa > standard > set_b


1 package kawa.standard;
2 import kawa.lang.*;
3 import gnu.mapping.*;
4 import gnu.expr.*;
5 import gnu.lists.*;
6 import gnu.kawa.functions.Setter;
7
8 /**
9  * The Syntax transformer that re-writes the Scheme "set!" primitive.
10  * @author Per Bothner
11  */
12
13 public class set_b extends Syntax
14 {
15   public static final set_b set = new set_b();
16   static { set.setName("set!"); }
17
18   public Expression rewriteForm (Pair form, Translator tr)
19   {
20     Object JavaDoc o1 = form.cdr;
21     SyntaxForm syntax = null;
22     while (o1 instanceof SyntaxForm)
23       {
24     syntax = (SyntaxForm) o1;
25     o1 = syntax.form;
26       }
27     if (! (o1 instanceof Pair))
28       return tr.syntaxError ("missing name");
29     Pair p1 = (Pair) o1;
30     Expression name = tr.rewrite_car(p1, syntax);
31     Object JavaDoc o2 = p1.cdr;
32     while (o2 instanceof SyntaxForm)
33       {
34     syntax = (SyntaxForm) o2;
35     o2 = syntax.form;
36       }
37     Pair p2;
38     if (! (o2 instanceof Pair)
39     || (p2 = (Pair) o2).cdr != LList.Empty)
40       return tr.syntaxError ("missing or extra arguments to set!");
41     Expression value = tr.rewrite_car(p2, syntax);
42
43     if (name instanceof ApplyExp)
44       {
45     // rewrite (set! (proc . args) rhs) => ((setter proc) args ... rhs)
46
47     ApplyExp aexp = (ApplyExp) name;
48         Expression[] args = aexp.getArgs();
49     int nargs = args.length;
50         int skip = 0;
51         Expression func = aexp.getFunction();
52         if (args.length > 0 && func instanceof ReferenceExp
53             && ((ReferenceExp) func).getBinding() == Scheme.applyFieldDecl)
54           {
55             skip = 1;
56             nargs--;
57             func = args[0];
58           }
59         Expression[] setterArgs = { func };
60     Expression[] xargs = new Expression[nargs+1];
61     System.arraycopy(args, skip, xargs, 0, nargs);
62     xargs[nargs] = value;
63     return new ApplyExp(new ApplyExp(new ReferenceExp(Setter.setterDecl),
64                                          setterArgs), xargs);
65       }
66     else if (! (name instanceof ReferenceExp))
67       return tr.syntaxError ("first set! argument is not a variable name");
68
69     ReferenceExp ref = (ReferenceExp) name;
70     Declaration decl = ref.getBinding();
71     SetExp sexp = new SetExp (ref.getSymbol(), value);
72     sexp.setContextDecl(ref.contextDecl());
73     if (decl != null)
74       {
75     sexp.setBinding(decl);
76     decl = Declaration.followAliases(decl);
77     if (decl != null)
78       decl.noteValue (value);
79     if (decl.getFlag(Declaration.IS_CONSTANT))
80       return tr.syntaxError ("constant variable is set!");
81       }
82     return sexp;
83   }
84 }
85
Popular Tags