001: package kawa.standard;
002:
003: import kawa.lang.*;
004: import gnu.lists.*;
005: import gnu.mapping.*;
006: import gnu.expr.*;
007: import java.util.Stack;
008:
009: /** Implementation of the standard Scheme let-syntax and letrec-syntax forms.
010: * Not quite working yet. */
011:
012: public class let_syntax extends Syntax {
013: public static final let_syntax let_syntax = new let_syntax(false,
014: "let-syntax");
015: public static final let_syntax letrec_syntax = new let_syntax(true,
016: "letrec-syntax");
017:
018: boolean recursive;
019:
020: public let_syntax(boolean recursive, String name) {
021: super (name);
022: this .recursive = recursive;
023: }
024:
025: public Expression rewrite(Object obj, Translator tr) {
026: if (!(obj instanceof Pair))
027: return tr.syntaxError("missing let-syntax arguments");
028: Pair pair = (Pair) obj;
029: Object bindings = pair.car;
030: Object body = pair.cdr;
031: int decl_count = Translator.listLength(bindings);
032: if (decl_count < 0)
033: return tr.syntaxError("bindings not a proper list");
034: Stack renamedAliases = null;
035: int renamedAliasesCount = 0;
036: Expression[] inits = new Expression[decl_count];
037: Declaration[] decls = new Declaration[decl_count];
038: Macro[] macros = new Macro[decl_count];
039: Pair[] transformers = new Pair[decl_count];
040: SyntaxForm[] trSyntax = new SyntaxForm[decl_count];
041: LetExp let = new LetExp(inits);
042: SyntaxForm listSyntax = null;
043: for (int i = 0; i < decl_count; i++) {
044: while (bindings instanceof SyntaxForm) {
045: listSyntax = (SyntaxForm) bindings;
046: bindings = listSyntax.form;
047: }
048: SyntaxForm bindingSyntax = listSyntax;
049: Pair bind_pair = (Pair) bindings;
050: Object bind_pair_car = bind_pair.car;
051: if (bind_pair_car instanceof SyntaxForm) {
052: bindingSyntax = (SyntaxForm) bind_pair_car;
053: bind_pair_car = bindingSyntax.form;
054: }
055: if (!(bind_pair_car instanceof Pair))
056: return tr.syntaxError(getName()
057: + " binding is not a pair");
058: Pair binding = (Pair) bind_pair_car;
059: Object name = binding.car;
060: SyntaxForm nameSyntax = bindingSyntax;
061: while (name instanceof SyntaxForm) {
062: nameSyntax = (SyntaxForm) name;
063: name = nameSyntax.form;
064: }
065: if (!(name instanceof String || name instanceof Symbol))
066: return tr.syntaxError("variable in " + getName()
067: + " binding is not a symbol");
068: Object binding_cdr = binding.cdr;
069: while (binding_cdr instanceof SyntaxForm) {
070: bindingSyntax = (SyntaxForm) binding_cdr;
071: binding_cdr = bindingSyntax.form;
072: }
073: if (!(binding_cdr instanceof Pair))
074: return tr.syntaxError(getName() + " has no value for '"
075: + name + "'");
076: binding = (Pair) binding_cdr;
077: if (binding.cdr != LList.Empty)
078: return tr.syntaxError("let binding for '" + name
079: + "' is improper list");
080: Declaration decl = new Declaration(name);
081: Macro macro = Macro.make(decl);
082: macros[i] = macro;
083: transformers[i] = binding;
084: trSyntax[i] = bindingSyntax;
085: let.addDeclaration(decl);
086: ScopeExp templateScope = nameSyntax == null ? null
087: : nameSyntax.scope;
088: if (templateScope != null) {
089: Declaration alias = tr.makeRenamedAlias(decl,
090: templateScope);
091: if (renamedAliases == null)
092: renamedAliases = new Stack();
093: renamedAliases.push(alias);
094: renamedAliasesCount++;
095: }
096: macro
097: .setCapturedScope(bindingSyntax != null ? bindingSyntax.scope
098: : recursive ? let : tr.currentScope());
099: decls[i] = decl;
100: inits[i] = QuoteExp.nullExp;
101: bindings = bind_pair.cdr;
102: }
103: if (recursive)
104: push(let, tr, renamedAliases);
105: Macro savedMacro = tr.currentMacroDefinition;
106: for (int i = 0; i < decl_count; i++) {
107: Macro macro = macros[i];
108: tr.currentMacroDefinition = macro;
109: Expression value = tr.rewrite_car(transformers[i],
110: trSyntax[i]);
111: inits[i] = value;
112: Declaration decl = decls[i];
113: macro.expander = value;
114: decl.noteValue(new QuoteExp(macro));
115: if (value instanceof LambdaExp) {
116: LambdaExp lvalue = (LambdaExp) value;
117: lvalue.nameDecl = decl;
118: lvalue.setSymbol(decl.getSymbol());
119: }
120: }
121: tr.currentMacroDefinition = savedMacro;
122: if (!recursive)
123: push(let, tr, renamedAliases);
124: Expression result = tr.rewrite_body(body);
125: tr.pop(let);
126: tr.popRenamedAlias(renamedAliasesCount);
127: return result;
128: }
129:
130: private void push(LetExp let, Translator tr, Stack renamedAliases) {
131: tr.push(let);
132: if (renamedAliases != null)
133: for (int i = renamedAliases.size(); --i >= 0;)
134: tr.pushRenamedAlias((Declaration) renamedAliases.pop());
135: }
136: }
|