|
1 package kawa.standard;
2 import kawa.lang.*;
3 import gnu.lists.*;
4 import gnu.mapping.*;
5 import gnu.expr.*;
6 import java.util.Stack  ;
7
8
10
11 public class let_syntax extends Syntax
12 {
13 public static final let_syntax let_syntax
14 = new let_syntax(false, "let-syntax");
15 public static final let_syntax letrec_syntax
16 = new let_syntax(true, "letrec-syntax");
17
18 boolean recursive;
19
20 public let_syntax(boolean recursive, String name)
21 {
22 super(name);
23 this.recursive = recursive;
24 }
25
26 public Expression rewrite (Object obj, Translator tr)
27 {
28 if (! (obj instanceof Pair))
29 return tr.syntaxError ("missing let-syntax arguments");
30 Pair pair = (Pair) obj;
31 Object bindings = pair.car;
32 Object body = pair.cdr;
33 int decl_count = Translator.listLength(bindings);
34 if (decl_count < 0)
35 return tr.syntaxError("bindings not a proper list");
36 Stack renamedAliases = null;
37 int renamedAliasesCount = 0;
38 Expression[] inits = new Expression[decl_count];
39 Declaration[] decls = new Declaration[decl_count];
40 Macro[] macros = new Macro[decl_count];
41 Pair[] transformers = new Pair[decl_count];
42 SyntaxForm[] trSyntax = new SyntaxForm[decl_count];
43 LetExp let = new LetExp (inits);
44 SyntaxForm listSyntax = null;
45 for (int i = 0; i < decl_count; i++)
46 {
47 while (bindings instanceof SyntaxForm)
48 {
49 listSyntax = (SyntaxForm) bindings;
50 bindings = listSyntax.form;
51 }
52 SyntaxForm bindingSyntax = listSyntax;
53 Pair bind_pair = (Pair) bindings;
54 Object bind_pair_car = bind_pair.car;
55 if (bind_pair_car instanceof SyntaxForm)
56 {
57 bindingSyntax = (SyntaxForm) bind_pair_car;
58 bind_pair_car = bindingSyntax.form;
59 }
60 if (! (bind_pair_car instanceof Pair))
61 return tr.syntaxError (getName()+" binding is not a pair");
62 Pair binding = (Pair) bind_pair_car;
63 Object name = binding.car;
64 SyntaxForm nameSyntax = bindingSyntax;
65 while (name instanceof SyntaxForm)
66 {
67 nameSyntax = (SyntaxForm) name;
68 name = nameSyntax.form;
69 }
70 if (! (name instanceof String || name instanceof Symbol))
71 return tr.syntaxError("variable in "+getName()+" binding is not a symbol");
72 Object binding_cdr = binding.cdr;
73 while (binding_cdr instanceof SyntaxForm)
74 {
75 bindingSyntax = (SyntaxForm) binding_cdr;
76 binding_cdr = bindingSyntax.form;
77 }
78 if (! (binding_cdr instanceof Pair))
79 return tr.syntaxError(getName()+" has no value for '"+name+"'");
80 binding = (Pair) binding_cdr;
81 if (binding.cdr != LList.Empty)
82 return tr.syntaxError("let binding for '"+name+"' is improper list");
83 Declaration decl = new Declaration(name);
84 Macro macro = Macro.make(decl);
85 macros[i] = macro;
86 transformers[i] = binding;
87 trSyntax[i] = bindingSyntax;
88 let.addDeclaration(decl);
89 ScopeExp templateScope = nameSyntax == null ? null : nameSyntax.scope;
90 if (templateScope != null)
91 {
92 Declaration alias = tr.makeRenamedAlias(decl, templateScope);
93 if (renamedAliases == null)
94 renamedAliases = new Stack ();
95 renamedAliases.push(alias);
96 renamedAliasesCount++;
97 }
98 macro.setCapturedScope(bindingSyntax != null ? bindingSyntax.scope
99 : recursive ? let : tr.currentScope());
100 decls[i] = decl;
101 inits[i] = QuoteExp.nullExp;
102 bindings = bind_pair.cdr;
103 }
104 if (recursive)
105 push(let, tr, renamedAliases);
106 Macro savedMacro = tr.currentMacroDefinition;
107 for (int i = 0; i < decl_count; i++)
108 {
109 Macro macro = macros[i];
110 tr.currentMacroDefinition = macro;
111 Expression value = tr.rewrite_car(transformers[i], trSyntax[i]);
112 inits[i] = value;
113 Declaration decl = decls[i];
114 macro.expander = value;
115 decl.noteValue(new QuoteExp(macro));
116 if (value instanceof LambdaExp)
117 {
118 LambdaExp lvalue = (LambdaExp) value;
119 lvalue.nameDecl = decl;
120 lvalue.setSymbol(decl.getSymbol());
121 }
122 }
123 tr.currentMacroDefinition = savedMacro;
124 if (! recursive)
125 push(let, tr, renamedAliases);
126 Expression result = tr.rewrite_body(body);
127 tr.pop(let);
128 tr.popRenamedAlias(renamedAliasesCount);
129 return result;
130 }
131
132 private void push (LetExp let, Translator tr, Stack renamedAliases)
133 {
134 tr.push(let);
135 if (renamedAliases != null)
136 for (int i = renamedAliases.size(); --i >= 0; )
137 tr.pushRenamedAlias((Declaration) renamedAliases.pop());
138 }
139 }
140 |
Popular Tags |
Java API By Example, From Geeks To Geeks.