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: /**
010: * The Syntax transformer that re-writes the Scheme "let" primitive.
011: * This only handles standard "unnamed" let.
012: * The let macro in ../lib/let.scm handles named let as well.
013: * @author Per Bothner
014: */
015:
016: public class let extends Syntax {
017: public static final let let = new let();
018: static {
019: let.setName("let");
020: }
021:
022: public Expression rewrite(Object obj, Translator tr) {
023: if (!(obj instanceof Pair))
024: return tr.syntaxError("missing let arguments");
025: Pair pair = (Pair) obj;
026: Object bindings = pair.car;
027: Object body = pair.cdr;
028: int decl_count = Translator.listLength(bindings);
029: if (decl_count < 0)
030: return tr.syntaxError("bindings not a proper list");
031:
032: Expression[] inits = new Expression[decl_count];
033: LetExp let = new LetExp(inits);
034: Stack renamedAliases = null;
035: int renamedAliasesCount = 0;
036: SyntaxForm syntaxRest = null;
037: for (int i = 0; i < decl_count; i++) {
038: while (bindings instanceof SyntaxForm) {
039: syntaxRest = (SyntaxForm) bindings;
040: bindings = syntaxRest.form;
041: // The SyntaxForm "surrounds" both the current binding (the car),
042: // as well as the cdr - i.e. the remaining bindings.
043: }
044: Pair bind_pair = (Pair) bindings;
045: Object bind_pair_car = bind_pair.car;
046: SyntaxForm syntax = syntaxRest;
047: if (bind_pair_car instanceof SyntaxForm) {
048: syntax = (SyntaxForm) bind_pair_car;
049: bind_pair_car = syntax.form;
050: }
051: if (!(bind_pair_car instanceof Pair))
052: return tr.syntaxError("let binding is not a pair:"
053: + bind_pair_car);
054: Pair binding = (Pair) bind_pair_car;
055: Object name = binding.car;
056: TemplateScope templateScope;
057: if (name instanceof SyntaxForm) {
058: SyntaxForm sf = (SyntaxForm) name;
059: name = sf.form;
060: templateScope = sf.scope;
061: } else
062: templateScope = syntax == null ? null : syntax.scope;
063: if (!(name instanceof String) && !(name instanceof Symbol))
064: return tr.syntaxError("variable " + name
065: + " in let binding is not a symbol: " + obj);
066:
067: Declaration decl = let.addDeclaration(name);
068:
069: if (templateScope != null) {
070: Declaration alias = tr.makeRenamedAlias(decl,
071: templateScope);
072: if (renamedAliases == null)
073: renamedAliases = new Stack();
074: renamedAliases.push(alias);
075: renamedAliasesCount++;
076: }
077:
078: Object binding_cdr = binding.cdr;
079: while (binding_cdr instanceof SyntaxForm) {
080: syntax = (SyntaxForm) binding_cdr;
081: binding_cdr = syntax.form;
082: }
083: if (!(binding_cdr instanceof Pair))
084: return tr.syntaxError("let has no value for '" + name
085: + "'");
086: binding = (Pair) binding_cdr;
087: binding_cdr = binding.cdr;
088: Pair init;
089: while (binding_cdr instanceof SyntaxForm) {
090: syntax = (SyntaxForm) binding_cdr;
091: binding_cdr = syntax.form;
092: }
093: if (tr.matches(binding.car, "::")) {
094: if (!(binding_cdr instanceof Pair)
095: || (binding = (Pair) binding_cdr).cdr == LList.Empty)
096: return tr
097: .syntaxError("missing type after '::' in let");
098: binding_cdr = binding.cdr;
099: while (binding_cdr instanceof SyntaxForm) {
100: syntax = (SyntaxForm) binding_cdr;
101: binding_cdr = syntax.form;
102: }
103: }
104: if (binding_cdr == LList.Empty) {
105: init = binding;
106: } else if (binding_cdr instanceof Pair) {
107: decl.setType(tr.exp2Type(binding));
108: decl.setFlag(Declaration.TYPE_SPECIFIED);
109: init = (Pair) binding_cdr;
110: } else
111: return tr.syntaxError("let binding for '" + name
112: + "' is improper list");
113: inits[i] = tr.rewrite_car(init, syntax);
114: if (init.cdr != LList.Empty)
115: return tr.syntaxError("junk after declaration of "
116: + name);
117: decl.noteValue(inits[i]);
118: bindings = bind_pair.cdr;
119: }
120:
121: for (int i = renamedAliasesCount; --i >= 0;)
122: tr.pushRenamedAlias((Declaration) renamedAliases.pop());
123:
124: tr.push(let);
125: let.body = tr.rewrite_body(body);
126: tr.pop(let);
127: tr.popRenamedAlias(renamedAliasesCount);
128:
129: return let;
130: }
131: }
|