001: package kawa.standard;
002:
003: import kawa.lang.*;
004: import gnu.lists.*;
005: import gnu.expr.*;
006: import gnu.math.IntNum;
007: import gnu.bytecode.*;
008:
009: public class syntax_case extends Syntax {
010: public static final syntax_case syntax_case = new syntax_case();
011: static {
012: syntax_case.setName("syntax-case");
013: }
014:
015: PrimProcedure call_error;
016:
017: Expression rewriteClauses(Object clauses, syntax_case_work work,
018: Translator tr) {
019: Language language = tr.getLanguage();
020: if (clauses == LList.Empty) {
021: /*
022: // FIXME - throw exception instead?? perhaps SyntaxException?
023: return new QuoteExp(new Pair("quote",
024: new Pair("((no match in syntax-case))",
025: LList.Empty)));
026: */
027: Expression[] args = new Expression[2];
028: args[0] = new QuoteExp("syntax-case");
029: args[1] = new ReferenceExp(work.inputExpression);
030: if (call_error == null) {
031: ClassType clas = ClassType
032: .make("kawa.standard.syntax_case");
033: Type[] argtypes = new Type[2];
034: argtypes[0] = Compilation.javaStringType;
035: argtypes[1] = Type.pointer_type;
036: Method method = clas.addMethod("error", argtypes,
037: Type.pointer_type, Access.PUBLIC
038: | Access.STATIC);
039: call_error = new PrimProcedure(method, language);
040: }
041: return new ApplyExp(call_error, args);
042: }
043: Object savePos = tr.pushPositionOf(clauses);
044: Object clause;
045: try {
046: if (!(clauses instanceof Pair)
047: || !((clause = ((Pair) clauses).car) instanceof Pair))
048: return tr.syntaxError("syntax-case: bad clause list");
049: Pair pair = (Pair) clause;
050: PatternScope clauseScope = PatternScope.push(tr);
051: clauseScope.matchArray = tr.matchArray;
052: tr.push(clauseScope);
053: int outerVarCount = clauseScope.pattern_names.size();
054: SyntaxPattern pattern = new SyntaxPattern(pair.car,
055: work.literal_identifiers, tr);
056: int varCount = pattern.varCount();
057: if (varCount > work.maxVars)
058: work.maxVars = varCount;
059:
060: BlockExp block = new BlockExp();
061: Expression[] args = new Expression[4];
062: args[0] = new QuoteExp(pattern);
063: args[1] = new ReferenceExp(work.inputExpression);
064: args[2] = new ReferenceExp(tr.matchArray);
065: args[3] = new QuoteExp(IntNum.zero());
066: Expression tryMatch = new ApplyExp(new PrimProcedure(
067: Pattern.matchPatternMethod, language), args);
068:
069: int newVarCount = varCount - outerVarCount;
070: Expression[] inits = new Expression[newVarCount];
071: for (int i = newVarCount; --i >= 0;)
072: inits[i] = QuoteExp.undefined_exp;
073: clauseScope.inits = inits;
074:
075: Expression output;
076: SyntaxForm syntax = null;
077: Object tail = pair.cdr;
078: while (tail instanceof SyntaxForm) {
079: syntax = (SyntaxForm) tail;
080: tail = syntax.form;
081: }
082: pair = (Pair) tail;
083: if (pair.cdr == LList.Empty)
084: output = tr.rewrite_car(pair, syntax);
085: else {
086: Expression fender = tr.rewrite_car(pair, syntax);
087: if (!(pair.cdr instanceof Pair && (pair = (Pair) pair.cdr).cdr == LList.Empty))
088: return tr.syntaxError("syntax-case: bad clause");
089: output = new IfExp(fender,
090: tr.rewrite_car(pair, syntax),
091: new ExitExp(block));
092: }
093: clauseScope.setBody(output);
094:
095: tr.pop(clauseScope);
096: PatternScope.pop(tr);
097: block.setBody(new IfExp(tryMatch, clauseScope, new ExitExp(
098: block)), rewriteClauses(((Pair) clauses).cdr, work,
099: tr));
100: return block;
101: } finally {
102: tr.popPositionOf(savePos);
103: }
104: }
105:
106: public Expression rewriteForm(Pair form, Translator tr) {
107: syntax_case_work work = new syntax_case_work();
108:
109: Object obj = form.cdr;
110: if (obj instanceof Pair && ((Pair) obj).cdr instanceof Pair) {
111: Expression[] linits = new Expression[2];
112: LetExp let = new LetExp(linits);
113: work.inputExpression = let.addDeclaration((String) null);
114:
115: Declaration matchArrayOuter = tr.matchArray;
116: Declaration matchArray = let.addDeclaration((String) null);
117: matchArray.setType(Compilation.objArrayType);
118: matchArray.setCanRead(true);
119: tr.matchArray = matchArray;
120: work.inputExpression.setCanRead(true);
121: tr.push(let);
122:
123: form = (Pair) obj;
124: linits[0] = tr.rewrite(form.car);
125: work.inputExpression.noteValue(linits[0]);
126: obj = form.cdr;
127:
128: form = (Pair) obj;
129: work.literal_identifiers = SyntaxPattern.getLiteralsList(
130: form.car, null, tr);
131: obj = form.cdr;
132:
133: let.body = rewriteClauses(obj, work, tr);
134: tr.pop(let);
135:
136: Method allocVars = ClassType
137: .make("kawa.lang.SyntaxPattern").getDeclaredMethod(
138: "allocVars", 2);
139: Expression[] args = new Expression[2];
140: args[0] = new QuoteExp(IntNum.make(work.maxVars));
141: if (matchArrayOuter == null)
142: args[1] = QuoteExp.nullExp;
143: else
144: args[1] = new ReferenceExp(matchArrayOuter);
145: linits[1] = new ApplyExp(allocVars, args);
146: matchArray.noteValue(linits[1]);
147: tr.matchArray = matchArrayOuter;
148: return let;
149: }
150: return tr.syntaxError("insufficiant arguments to syntax-case");
151: }
152:
153: /** Called (at run-time) if syntax-case has no match. */
154: public static Object error(String kind, Object arg) {
155: Translator tr = (Translator) Compilation.getCurrent();
156: if (tr == null)
157: throw new RuntimeException("no match in syntax-case");
158: Syntax syntax = tr.getCurrentSyntax();
159: String name = syntax == null ? "some syntax" : syntax.getName();
160: String msg = "no matching case while expanding " + name;
161: return tr.syntaxError(msg);
162: }
163: }
164:
165: class syntax_case_work {
166: LetExp let;
167: Object[] literal_identifiers;
168:
169: /** A temporary to hold the value of the input expression. */
170: Declaration inputExpression;
171:
172: /** The maximum of the varCount() for the patterns seen so far. */
173: int maxVars;
174: }
|