1 package kawa.standard; 2 import gnu.lists.*; 3 import gnu.mapping.*; 4 import gnu.expr.*; 5 import gnu.kawa.functions.IsEq; 6 import gnu.kawa.reflect.Invoke; 7 import gnu.kawa.reflect.SlotGet; 8 9 12 13 public class map extends gnu.mapping.ProcedureN implements CanInline 14 { 15 16 boolean collect; 17 18 public map (boolean collect) 19 { 20 super (collect ? "map" : "for-each"); 21 this.collect = collect; 22 } 23 24 25 static public Object map1 (Procedure proc, Object list) throws Throwable 26 { 27 Object result = LList.Empty; 28 Pair last = null; 29 while (list != LList.Empty) 30 { 31 Pair pair = (Pair) list; 32 Pair new_pair = new Pair (proc.apply1 (pair.car), LList.Empty); 33 if (last == null) 34 result = new_pair; 35 else 36 last.cdr = new_pair; 37 last = new_pair; 38 list = pair.cdr; 39 } 40 return result; 41 } 42 43 44 static public void forEach1 (Procedure proc, Object list) throws Throwable 45 { 46 while (list != LList.Empty) 47 { 48 Pair pair = (Pair) list; 49 proc.apply1 (pair.car); 50 list = pair.cdr; 51 } 52 } 53 54 public Object apply2 (Object arg1, Object arg2) throws Throwable 55 { 56 Procedure proc = (Procedure) arg1; 57 if (collect) 58 return map1 (proc, arg2); 59 forEach1 (proc, arg2); 60 return Values.empty; 61 } 62 63 public Object applyN (Object [] args) throws Throwable 64 { 65 Procedure proc = (Procedure) (args[0]); 66 int arity = args.length - 1; 67 if (arity == 1) 68 { 69 if (collect) 70 return map1 (proc, args[1]); 71 forEach1 (proc, args[1]); 72 return Values.empty; 73 } 74 Object result; 75 Pair last = null; 76 if (collect) 77 result = LList.Empty; 78 else 79 result = Values.empty;; 80 Object [] rest = new Object [arity]; 81 System.arraycopy (args, 1, rest, 0, arity); 82 Object [] each_args = new Object [arity]; 83 for (;;) 84 { 85 for (int i = 0; i < arity; i++) 86 { 87 Object list = rest[i]; 88 if (list == LList.Empty) 89 return result; 90 Pair pair = (Pair) list; 91 each_args[i] = pair.car; 92 rest[i] = pair.cdr; 93 } 94 Object value = proc.applyN (each_args); 95 if (collect) 96 { 97 Pair new_pair = new Pair (value, LList.Empty); 98 if (last == null) 99 result = new_pair; 100 else 101 last.cdr = new_pair; 102 last = new_pair; 103 } 104 } 105 } 106 107 public Expression inline (ApplyExp exp, ExpWalker walker) 108 { 109 Expression[] args = exp.getArgs(); 110 int nargs = args.length; 111 if (nargs < 2) 112 return exp; 114 InlineCalls inliner = (InlineCalls) walker; 115 116 nargs--; 117 118 Expression proc = args[0]; 119 boolean procSafeForMultipleEvaluation = ! proc.side_effects(); 123 124 Expression[] inits1 = new Expression[1]; 126 inits1[0] = proc; 127 LetExp let1 = new LetExp(inits1); 128 Declaration procDecl 129 = let1.addDeclaration("%proc", Compilation.typeProcedure); 130 procDecl.noteValue(args[0]); 131 132 Expression[] inits2 = new Expression[1]; 134 LetExp let2 = new LetExp(inits2); 135 let1.setBody(let2); 136 LambdaExp lexp = new LambdaExp(collect ? nargs + 1 : nargs); 137 inits2[0] = lexp; 138 Declaration loopDecl = let2.addDeclaration("%loop"); 139 loopDecl.noteValue(lexp); 140 141 Expression[] inits3 = new Expression[nargs]; 143 LetExp let3 = new LetExp(inits3); 144 145 Declaration[] largs = new Declaration[nargs]; 146 Declaration[] pargs = new Declaration[nargs]; 147 IsEq isEq = Scheme.isEq; 148 for (int i = 0; i < nargs; i++) 149 { 150 String argName = "arg"+i; 151 largs[i] = lexp.addDeclaration(argName); 152 pargs[i] = let3.addDeclaration(argName, Compilation.typePair); 153 inits3[i] = new ReferenceExp(largs[i]); 154 pargs[i].noteValue(inits3[i]); 155 } 156 Declaration resultDecl = collect ? lexp.addDeclaration("result") : null; 157 158 Expression[] doArgs = new Expression[nargs]; 159 Expression[] recArgs = new Expression[collect ? nargs + 1 : nargs]; 160 for (int i = 0; i < nargs; i++) 161 { 162 doArgs[i] = inliner.walkApplyOnly(SlotGet.makeGetField(new ReferenceExp(pargs[i]), "car")); 163 recArgs[i] = inliner.walkApplyOnly(SlotGet.makeGetField(new ReferenceExp(pargs[i]), "cdr")); 164 } 165 if (! procSafeForMultipleEvaluation) 166 proc = new ReferenceExp(procDecl); 167 Expression doit = inliner.walkApplyOnly(new ApplyExp(proc, doArgs)); 168 Expression rec = inliner.walkApplyOnly(new ApplyExp(new ReferenceExp(loopDecl), recArgs)); 169 if (collect) 170 { 171 Expression[] consArgs = new Expression[2]; 172 consArgs[0] = doit; 173 consArgs[1] = new ReferenceExp(resultDecl); 174 recArgs[nargs] = Invoke.makeInvokeStatic(Compilation.typePair, 175 "make", consArgs); 176 lexp.body = rec; 177 } 178 else 179 { 180 lexp.body = new BeginExp(doit, rec); 181 } 182 let3.setBody(lexp.body); 183 lexp.body = let3; 184 Expression[] initArgs = new Expression[collect ? nargs + 1 : nargs]; 185 QuoteExp empty = new QuoteExp(LList.Empty); 186 for (int i = nargs; --i >= 0; ) 187 { 188 Expression[] compArgs = new Expression[2]; 189 compArgs[0] = new ReferenceExp(largs[i]); 190 compArgs[1] = empty; 191 Expression result 192 = collect ? (Expression) new ReferenceExp(resultDecl) 193 : (Expression) QuoteExp.voidExp; 194 lexp.body = new IfExp(inliner.walkApplyOnly(new ApplyExp(isEq, compArgs)), 195 result, lexp.body); 196 initArgs[i] = args[i+1]; 197 } 198 if (collect) 199 initArgs[nargs] = empty; 200 201 Expression body = inliner.walkApplyOnly(new ApplyExp(new ReferenceExp(loopDecl), initArgs)); 202 if (collect) 203 { 204 Expression[] reverseArgs = new Expression[1]; 205 reverseArgs[0] = body; 206 body = Invoke.makeInvokeStatic(Compilation.scmListType, 207 "reverseInPlace", reverseArgs); 208 } 209 let2.setBody(body); 210 211 if (procSafeForMultipleEvaluation) 212 return let2; 213 else 214 return let1; 215 } 216 } 217 | Popular Tags |