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 "%define" internal form.
010: * This is used to implement define, define-private, and define-constant.
011: * Syntax: <code>(%define name code type value)</code>.
012: * The <code>name</code> is an identifier (<code>String</code> or
013: * <code>Symbol</code>) or </code>Declaration</code>.
014: * The <code>code</code> is an integer mask,
015: * where 1 means type specified, 2 means a function definition,
016: * 4 means private, and 8 means constant.
017: * The <code>type</code> is the declarated type or <code>null</code>.
018: * The <code>value</code> is the initializing value. *
019: * @author Per Bothner
020: */
021:
022: public class define extends Syntax {
023: public static final define defineRaw = new define(Scheme.lambda);
024:
025: Lambda lambda;
026:
027: String getName(int options) {
028: if ((options & 4) != 0)
029: return "define-private";
030: else if ((options & 8) != 0)
031: return "define-constant";
032: else
033: return "define";
034: }
035:
036: public define(Lambda lambda) {
037: this .lambda = lambda;
038: }
039:
040: public void scanForm(Pair st, ScopeExp defs, Translator tr) {
041: Pair p1 = (Pair) st.cdr;
042: Pair p2 = (Pair) p1.cdr;
043: Pair p3 = (Pair) p2.cdr;
044: Pair p4 = (Pair) p3.cdr;
045: SyntaxForm nameSyntax = null;
046: Object name = p1.car;
047: while (name instanceof SyntaxForm) {
048: nameSyntax = (SyntaxForm) name;
049: name = nameSyntax.form;
050: }
051: int options = ((Number) Translator.stripSyntax(p2.car))
052: .intValue();
053: boolean makePrivate = (options & 4) != 0;
054: boolean makeConstant = (options & 8) != 0;
055:
056: ScopeExp scope = tr.currentScope();
057: name = tr.namespaceResolve(name);
058: if (!(name instanceof String || name instanceof Symbol)) {
059: tr.error('e', "'" + name + "' is not a valid identifier");
060: name = null;
061: }
062:
063: Object savePos = tr.pushPositionOf(p1);
064: Declaration decl = tr.define(name, nameSyntax, defs);
065: tr.popPositionOf(savePos);
066: name = decl.getSymbol();
067: if (makePrivate) {
068: decl.setFlag(Declaration.PRIVATE_SPECIFIED);
069: decl.setPrivate(true);
070: }
071: if (makeConstant)
072: decl.setFlag(Declaration.IS_CONSTANT);
073:
074: if ((options & 2) != 0) {
075: LambdaExp lexp = new LambdaExp();
076: decl.setProcedureDecl(true);
077: decl.setType(Compilation.typeProcedure);
078: lexp.setSymbol(name);
079: lexp.nameDecl = decl;
080: Object formals = p4.car;
081: Object body = p4.cdr;
082: Translator.setLine(lexp, p1);
083: lambda.rewriteFormals(lexp, formals, tr, null);
084: Object realBody = lambda.rewriteAttrs(lexp, body, tr);
085: if (realBody != body)
086: p2 = new Pair(p2.car, new Pair(p3.car, new Pair(
087: formals, realBody)));
088: decl.noteValue(lexp);
089: }
090:
091: if (defs instanceof ModuleExp) {
092: if (!makePrivate) {
093: decl.setCanRead(true);
094: // (define (f) ...) defaults f to being read-only,
095: // unless f is assigned to in this module.
096: if (!makeConstant
097: && ((options & 2) == 0 || !Compilation.inlineOk))
098: decl.setCanWrite(true);
099: }
100: }
101:
102: if ((options & 1) != 0) {
103: decl.setType(tr.exp2Type(p3));
104: decl.setFlag(Declaration.TYPE_SPECIFIED);
105: }
106:
107: st = Translator.makePair(st, this , Translator.makePair(p1,
108: decl, p2));
109: Translator.setLine(decl, p1);
110:
111: tr.formStack.addElement(st);
112: }
113:
114: public Expression rewriteForm(Pair form, Translator tr) {
115: Pair p1 = (Pair) form.cdr;
116: Pair p2 = (Pair) p1.cdr;
117: Pair p3 = (Pair) p2.cdr;
118: Pair p4 = (Pair) p3.cdr;
119: Object name = Translator.stripSyntax(p1.car);
120: int options = ((Number) Translator.stripSyntax(p2.car))
121: .intValue();
122: boolean makePrivate = (options & 4) != 0;
123:
124: if (!(name instanceof Declaration))
125: return tr.syntaxError(getName(options)
126: + " is only allowed in a <body>");
127: Declaration decl = (Declaration) name;
128:
129: Expression value;
130: if ((options & 2) != 0) {
131: LambdaExp lexp = (LambdaExp) decl.getValue();
132: Object body = p4.cdr;
133: lambda.rewriteBody(lexp, body, tr);
134: value = lexp;
135: } else {
136: value = tr.rewrite(p4.car);
137: decl.noteValue((decl.context instanceof ModuleExp
138: && !makePrivate && decl.getCanWrite()) ? null
139: : value);
140: }
141: SetExp sexp = new SetExp(decl, value);
142: sexp.setDefining(true);
143: if (makePrivate && !(tr.currentScope() instanceof ModuleExp))
144: tr.error('w', "define-private not at top level "
145: + tr.currentScope());
146: return sexp;
147: }
148: }
|