1 // Copyright (C) 2005 Per M.A. Bothner. 2 // This is free software; for terms and warranty disclaimer see ../../COPYING. 3 4 package kawa.standard; 5 import kawa.lang.*; 6 import gnu.expr.*; 7 import gnu.bytecode.ClassType; 8 import gnu.mapping.*; 9 import gnu.lists.*; 10 11 public class define_syntax extends Syntax 12 { 13 int flags; 14 15 public static final define_syntax define_macro 16 = new define_syntax("%define-macro", false); 17 18 public static final define_syntax define_syntax 19 = new define_syntax("%define-syntax", true); 20 21 public static final define_syntax define_rewrite_syntax 22 = new define_syntax("define-rewrite-syntax", Macro.HYGIENIC|Macro.SKIP_SCAN_FORM); 23 define_syntax()24 public define_syntax() { 25 flags = Macro.HYGIENIC; 26 } 27 define_syntax(Object name, int flags)28 public define_syntax(Object name, int flags) { 29 super(name); 30 this.flags = flags; 31 } 32 define_syntax(Object name, boolean hygienic)33 public define_syntax(Object name, boolean hygienic) { 34 this(name, hygienic ? Macro.HYGIENIC : 0); 35 } 36 37 static ClassType typeMacro = ClassType.make("kawa.lang.Macro"); 38 static PrimProcedure makeHygienic 39 = new PrimProcedure(typeMacro.getDeclaredMethod("make", 3)); 40 static PrimProcedure makeNonHygienic 41 = new PrimProcedure(typeMacro.getDeclaredMethod("makeNonHygienic", 3)); 42 static PrimProcedure makeSkipScanForm 43 = new PrimProcedure(typeMacro.getDeclaredMethod("makeSkipScanForm", 3)); 44 static PrimProcedure setCapturedScope 45 = new PrimProcedure(typeMacro.getDeclaredMethod("setCapturedScope", 1)); 46 static { makeHygienic.setSideEffectFree()47 makeHygienic.setSideEffectFree(); makeNonHygienic.setSideEffectFree()48 makeNonHygienic.setSideEffectFree(); makeSkipScanForm.setSideEffectFree()49 makeSkipScanForm.setSideEffectFree(); 50 } 51 scanForm(Pair st, ScopeExp defs, Translator tr)52 public void scanForm(Pair st, ScopeExp defs, Translator tr) { 53 SyntaxForm syntax = null; 54 Object st_cdr = st.getCdr(); 55 while (st_cdr instanceof SyntaxForm) { 56 syntax = (SyntaxForm) st_cdr; 57 st_cdr = syntax.getDatum(); 58 } 59 Object p = st_cdr; 60 Object name; 61 if (p instanceof Pair) { 62 Pair pp = (Pair) p; 63 name = pp.getCar(); 64 p = pp.getCdr(); 65 } 66 else 67 name = null; 68 SyntaxForm nameSyntax = syntax; 69 while (name instanceof SyntaxForm) { 70 nameSyntax = (SyntaxForm) name; 71 name = nameSyntax.getDatum(); 72 } 73 name = tr.namespaceResolve(name); 74 if (! (name instanceof Symbol)) { 75 tr.pushForm(tr.syntaxError("missing macro name for "+Translator.safeCar(st))); 76 return; 77 } 78 if (p == null || Translator.safeCdr(p) != LList.Empty) { 79 tr.pushForm(tr.syntaxError("invalid syntax for "+getName())); 80 return; 81 } 82 83 Declaration decl = tr.define(name, nameSyntax, defs); 84 decl.setType(typeMacro); 85 tr.push(decl); 86 87 Macro savedMacro = tr.currentMacroDefinition; 88 Macro macro = Macro.make(decl); 89 macro.setFlags(flags); 90 Expression rule; 91 ScopeExp scope = syntax != null ? syntax.getScope() : tr.currentScope(); 92 rule = new LangExp(new Object[]{ p, tr, scope }); 93 macro.expander = rule; 94 // A top-level macro needs (in general) to be compiled into the 95 // class-file, but for a non-top-level macro it is better to use 96 // the quoted macro directly to get the right nesting, as we 97 // do for letrec-syntax. 98 rule = new QuoteExp(macro); 99 decl.noteValue(rule); 100 decl.setProcedureDecl(true); 101 102 if (decl.context instanceof ModuleExp) { 103 SetExp result = new SetExp (decl, rule); 104 result.setDefining (true); 105 if (tr.getLanguage().hasSeparateFunctionNamespace()) 106 result.setFuncDef(true); 107 Object ret = Translator.makePair(st, this, 108 Translator.makePair(st, result, LList.Empty)); 109 tr.pushForm(ret); 110 111 if (tr.immediate) { 112 Expression[] args = 113 { new ReferenceExp(decl), new QuoteExp(defs) }; 114 tr.pushForm(new ApplyExp(setCapturedScope, args)); 115 } 116 } else { 117 macro.rewriteIfNeeded(); 118 } 119 } 120 rewriteForm(Pair form, Translator tr)121 public Expression rewriteForm(Pair form, Translator tr) { 122 if (form instanceof Pair) { 123 Pair p1 = (Pair) form.getCdr(); 124 Object x1 = p1.getCar(); 125 if (x1 instanceof SetExp) { 126 SetExp sexp = (SetExp) x1; 127 Object val = sexp.getNewValue().valueIfConstant(); 128 Declaration decl = sexp.getBinding(); 129 Object name = decl.getSymbol(); 130 ScopeExp defs = decl.getContext(); 131 if (val instanceof Macro) { 132 Macro macro = (Macro) val; 133 macro.rewriteIfNeeded(); 134 Expression rule = (Expression) macro.expander; 135 Procedure makeMacroProc = 136 (flags & Macro.SKIP_SCAN_FORM) != 0 ? makeSkipScanForm 137 : (flags & Macro.HYGIENIC) != 0 ? makeHygienic 138 : makeNonHygienic; 139 if (defs instanceof ModuleExp) 140 rule = new ApplyExp(makeMacroProc, 141 new QuoteExp(name), 142 rule, 143 ThisExp.makeGivingContext(defs)); 144 sexp.setNewValue(rule); 145 decl.setValue(rule); 146 } 147 return (SetExp) x1; 148 } 149 } 150 return tr.syntaxError("define-syntax not in a body"); 151 } 152 } 153