1 package gnu.q2.lang;
2 
3 import gnu.bytecode.Type;
4 import gnu.kawa.functions.MakeSplice;
5 import gnu.kawa.lispexpr.LispLanguage;
6 import gnu.mapping.Procedure;
7 import gnu.expr.*;
8 import gnu.text.*;
9 import gnu.lists.*;
10 import gnu.mapping.Symbol;
11 import kawa.lang.*;
12 import kawa.standard.Scheme;
13 import kawa.standard.SchemeCompilation;
14 import java.util.ArrayList;
15 import java.util.Stack;
16 
17 public class Q2Translator extends SchemeCompilation
18 {
Q2Translator(Language language, SourceMessages messages, NameLookup lexical)19   public Q2Translator (Language language, SourceMessages messages, NameLookup lexical)
20   {
21     super(language, messages, lexical);
22   }
23 
checkIfOperator(Object obj)24     Operator checkIfOperator(Object obj) {
25         if (obj instanceof Symbol && ! Q2.instance.selfEvaluatingSymbol(obj))  {
26             Expression func = rewrite(obj, true);
27             Declaration decl;
28             Object value;
29             if (func instanceof ReferenceExp
30                 && (decl = ((ReferenceExp) func).getBinding()) != null
31                 && (value = decl.getConstantValue()) instanceof Operator)
32             return (Operator) value;
33         } else if (obj instanceof Operator)
34             return (Operator) obj;
35         return null;
36     }
37 
38   /** Split list according to operator-precedence priorities.
39    */
partition(Object p, Q2Translator tr)40   public static Object partition (Object p, Q2Translator tr)
41   {
42     // A stack of: Fence, (arg-list, arg-last, Pair, Operator)*
43     // The "value" of each Pair<Operator> is the same as the following Operator.
44     // The invariant is that for each i, where i is 0, 4, 11, ..., we have:
45     // ((Operator)st.get(i)).rprio < ((Operator)st.get(i+4)).lprio
46     Stack st = new Stack();
47     st.add(Operator.FENCE);
48     Object larg = p;
49     Pair prev = null;
50 
51     for (;;)
52       {
53         if (p instanceof SyntaxForm)
54           ; // FIXME
55         Operator op = null;
56         Pair pp;
57         if (! (p instanceof Pair))
58           {
59             op = Operator.FENCE;
60             pp = null;
61           }
62         else
63           {
64             pp = (Pair) p;
65             Object obj = pp.getCar();
66             op = tr.checkIfOperator(obj);
67           }
68         if (op != null)
69           {
70             if (prev == null)
71               larg = LList.Empty;
72             else if (p instanceof Pair)
73               prev.setCdrBackdoor(LList.Empty);
74             int stsz = st.size();
75             Operator topop = (Operator) st.get(stsz-1);
76             while (op.lprio <= topop.rprio)
77               {
78                 PairWithPosition oppair = (PairWithPosition) st.get(stsz-2);
79                 if ((topop.flags & Operator.RHS_NEEDED) != 0
80                       && larg == LList.Empty)
81                     tr.error('e', "missing right operand after "+topop.getName(), oppair);
82                 LList prefixArgs = (LList) st.get(stsz-4);
83                 if (topop.lprio == Operator.UNARY_PRIO) {
84                     Pair prefixTail = (Pair) st.get(stsz-3);
85                     Object narg = topop.combine(LList.Empty, larg,
86                                          oppair);
87                     narg = new Pair(narg, LList.Empty);
88                     if (prefixTail == null)
89                         larg = narg;
90                     else {
91                         larg = prefixArgs;
92                         prefixTail.setCdrBackdoor(narg);
93                     }
94                 } else
95                     larg = topop.combine(prefixArgs, larg, oppair);
96                 stsz -= 4;
97                 st.setSize(stsz);
98                 topop = (Operator) st.get(stsz-1);
99               }
100             if (pp == null)
101               break;
102             st.add(larg);
103             st.add(prev);
104             st.add(pp);
105             st.add(op);
106             larg = pp.getCdr();
107             prev = null;
108           }
109         else
110           prev = pp;
111         p = pp.getCdr();
112       }
113     return larg;
114   }
makeBody(Expression[] exps)115     public Expression makeBody(Expression[] exps) {
116         int nlen = exps.length;
117         for (int i = 0; i < nlen-1; i++) {
118             Expression exp = exps[i];
119             if (exp instanceof IfExp) {
120                 IfExp iexp = (IfExp) exp;
121                 if (iexp.getElseClause() == null) {
122                     Expression[] rest = new Expression[nlen-i-1];
123                     System.arraycopy(exps, i+1, rest, 0, rest.length);
124                     iexp = new IfExp(iexp.getTest(), iexp.getThenClause(),
125                                      makeBody(rest));
126                     iexp.setLine(exp);
127                     if (i == 0)
128                         return iexp;
129                     Expression[] init = new Expression[i+1];
130                     System.arraycopy(exps, 0, init, 0, i);
131                     init[i] = iexp;
132                     return super.makeBody(init);
133                 }
134             }
135         }
136         return super.makeBody(exps);
137     }
138 
scanForm(Object st, ScopeExp defs)139   public void scanForm (Object st, ScopeExp defs)
140   {
141     if (st instanceof LList)
142       st = partition(st, this);
143     if (st != LList.Empty)
144       super.scanForm(st, defs);
145   }
146 
rewrite(Object exp, boolean function)147   public Expression rewrite (Object exp, boolean function)
148   {
149     if (exp == LList.Empty)
150       return QuoteExp.voidExp;
151     return super.rewrite(exp, function);
152   }
153 
rewrite_pair(Pair p, boolean function)154   public Expression rewrite_pair (Pair p, boolean function)
155   {
156     Object partitioned = partition(p, this);
157     if (partitioned instanceof Pair) {
158         Pair pair = (Pair) partitioned;
159         Object p_car = pair.getCar();
160         if (p_car instanceof Pair
161             && ((Pair) p_car).getCar() == LispLanguage.splice_sym)
162             return new ApplyExp(MakeSplice.quoteInstance,
163                                 rewrite_car((Pair)((Pair) p_car).getCdr(), function));
164         else {
165             Expression exp = super.rewrite_pair(pair, function);
166             ApplyExp app;
167             if (exp instanceof ApplyExp) {
168                 Expression fun = (app = (ApplyExp) exp).getFunction();
169                 if (isApplyFunction(fun))
170                     exp = convertApply(app);
171                 else if (fun instanceof LambdaExp && app.getArgCount() == 0)
172                     return fun;
173             }
174             return exp;
175         }
176     }
177     else
178       return rewrite(partitioned, function);
179   }
180 
181     /** If the argument has zero arguments, should we still apply it? */
applyNullary(Expression exp)182     public static boolean applyNullary(Expression exp) {
183         if (exp instanceof ReferenceExp) {
184             Declaration decl =
185                 Declaration.followAliases(((ReferenceExp) exp).getBinding());
186             if (decl != null) {
187                 if (decl.isProcedureDecl())
188                     return true;
189                 if (decl.getFlag(Declaration.STATIC_SPECIFIED)
190                     && decl.getFlag(Declaration.IS_CONSTANT)) { // kludge
191                     Type type = decl.getType();
192                     if ("gnu.kawa.lispexpr.LangObjType" == type.getName())
193                         return true;
194                 }
195             }
196         }
197         if (exp instanceof QuoteExp) {
198             Object val = exp.valueIfConstant();
199             return val instanceof Type || val instanceof Class;
200         }
201         return false;
202     }
203 
convertApply(ApplyExp exp)204     public static Expression convertApply(ApplyExp exp) {
205 
206         Expression[] args = exp.getArgs();
207         int nargs = args.length;
208 
209         Expression arg0 = args[0];
210         if (nargs == 1 && ! applyNullary(arg0)) {
211             if (arg0 instanceof IfExp
212                 && ((IfExp) arg0).getElseClause() == null)
213                 arg0 = new BeginExp(args);
214             return arg0;
215         }
216 
217         ArrayList<Expression> rargs = new ArrayList<Expression>();
218 
219         LetExp let = null;
220         for (int i = 0; i < nargs; i++) {
221             Expression arg = exp.getArg(i);
222             Expression barg;
223             if (arg instanceof LetExp && arg.getFlag(LetExp.IS_BODY_SCOPE)
224                 // Can we get more than one LetExp? FIXME
225                 && let == null) {
226                 barg = ((LetExp) arg).getBody();
227             } else
228                 barg = arg;
229             if (barg instanceof ApplyExp) {
230                 ApplyExp aarg = (ApplyExp) barg;
231                 if (aarg.isAppendValues()) {
232                     if (arg != barg)
233                         let = (LetExp) arg;
234                     int naarg = aarg.getArgCount();
235                     for (int j = 0; j < naarg;  j++) {
236                         Expression xaarg = aarg.getArg(j);
237                         if (xaarg instanceof SetExp) {
238                             xaarg = new ApplyExp(MakeSplice.quoteInstance,
239                                                  new BeginExp(xaarg, QuoteExp.emptyExp));
240                             if (exp.firstSpliceArg == -1
241                                 || exp.firstSpliceArg > j)
242                                 exp.firstSpliceArg = j;
243                         }
244                         rargs.add(xaarg);
245                     }
246                     continue;
247                 }
248             }
249             rargs.add(arg);
250         }
251         args = rargs.toArray(new Expression[rargs.size()]);
252         Procedure proc = Scheme.applyToArgs;
253         exp.setFuncArgs(new QuoteExp(proc), args);
254         if (let != null) {
255             let.setBody(exp);
256             return let;
257         }
258         return exp;
259     }
260 }
261