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