001: package kawa.standard;
002:
003: import kawa.lang.*;
004: import gnu.mapping.*;
005: import gnu.expr.*;
006: import gnu.lists.*;
007:
008: /**
009: * The Syntax transformer that re-writes the Scheme "fluid-let" primitive.
010: * @author Per Bothner
011: */
012:
013: public class fluid_let extends Syntax {
014: public static final fluid_let fluid_let = new fluid_let();
015: static {
016: fluid_let.setName("fluid-set");
017: }
018:
019: /** True if bindings should be evaluated sequentionally, as in ELisp let*. */
020: boolean star;
021:
022: /** Value to use if an initial value is not specified.
023: * Null means use the existing binding. */
024: Expression defaultInit;
025:
026: public fluid_let(boolean star, Expression defaultInit) {
027: this .star = star;
028: this .defaultInit = defaultInit;
029: }
030:
031: public fluid_let() {
032: this .star = false;
033: }
034:
035: public Expression rewrite(Object obj, Translator tr) {
036: if (!(obj instanceof Pair))
037: return tr.syntaxError("missing let arguments");
038: Pair pair = (Pair) obj;
039: return rewrite(pair.car, pair.cdr, tr);
040: }
041:
042: public Expression rewrite(Object bindings, Object body,
043: Translator tr) {
044: int decl_count = star ? 1 : LList.length(bindings);
045: Expression[] inits = new Expression[decl_count];
046: FluidLetExp let = new FluidLetExp(inits);
047: for (int i = 0; i < decl_count; i++) {
048: Pair bind_pair = (Pair) bindings;
049: Object savePos = tr.pushPositionOf(bind_pair);
050: try {
051: Expression value;
052: Pair binding;
053: Object name = bind_pair.car;
054: if (name instanceof String || name instanceof Symbol) {
055: value = defaultInit;
056: } else if (name instanceof Pair
057: && ((binding = (Pair) name).car instanceof String
058: || binding.car instanceof Symbol || binding.car instanceof SyntaxForm)) {
059: name = binding.car;
060: if (name instanceof SyntaxForm)
061: name = ((SyntaxForm) name).form;
062:
063: if (binding.cdr == LList.Empty)
064: value = defaultInit;
065: else if (!(binding.cdr instanceof Pair)
066: || (binding = (Pair) binding.cdr).cdr != LList.Empty)
067: return tr
068: .syntaxError("bad syntax for value of "
069: + name + " in " + getName());
070: else
071: value = tr.rewrite(binding.car);
072: } else
073: return tr.syntaxError("invalid " + getName()
074: + " syntax");
075: Declaration decl = let.addDeclaration(name);
076: Declaration found = tr.lexical.lookup(name, false);
077: if (found != null) {
078: if (found.isLexical())
079: found.setIndirectBinding(true);
080: decl.base = found;
081: }
082: decl.setFluid(true);
083: decl.setIndirectBinding(true);
084: if (value == null)
085: value = new ReferenceExp(name);
086: inits[i] = value;
087: decl.noteValue(null);
088: bindings = bind_pair.cdr;
089: } finally {
090: tr.popPositionOf(savePos);
091: }
092: }
093: tr.push(let);
094: if (star && bindings != LList.Empty)
095: let.body = rewrite(bindings, body, tr);
096: else
097: let.body = tr.rewrite_body(body);
098: tr.pop(let);
099: return let;
100: }
101: }
|