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