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