KickJava   Java API By Example, From Geeks To Geeks.

Java > Open Source Codes > kawa > standard > map


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 /** Implement the Scheme standard functions "map" and "for-each".
10  * @author Per Bothner
11  */

12
13 public class map extends gnu.mapping.ProcedureN implements CanInline
14 {
15   /** True if we should collect the result into a list. */
16   boolean collect;
17
18   public map (boolean collect)
19   {
20     super (collect ? "map" : "for-each");
21     this.collect = collect;
22   }
23
24   /** An optimized single-list version of map. */
25   static public Object JavaDoc map1 (Procedure proc, Object JavaDoc list) throws Throwable JavaDoc
26   {
27     Object JavaDoc 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   /** An optimized single-list version of for-each. */
44   static public void forEach1 (Procedure proc, Object JavaDoc list) throws Throwable JavaDoc
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 JavaDoc apply2 (Object JavaDoc arg1, Object JavaDoc arg2) throws Throwable JavaDoc
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 JavaDoc applyN (Object JavaDoc[] args) throws Throwable JavaDoc
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 JavaDoc result;
75     Pair last = null;
76     if (collect)
77       result = LList.Empty;
78     else
79       result = Values.empty;;
80     Object JavaDoc[] rest = new Object JavaDoc [arity];
81     System.arraycopy (args, 1, rest, 0, arity);
82     Object JavaDoc[] each_args = new Object JavaDoc [arity];
83     for (;;)
84       {
85     for (int i = 0; i < arity; i++)
86       {
87         Object JavaDoc 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 JavaDoc 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; // ERROR
113

114     InlineCalls inliner = (InlineCalls) walker;
115
116     nargs--;
117
118     Expression proc = args[0];
119     // If evaluating proc doesn't have side-effects, then we want to do
120
// so inside loop, since that turns a "read" info a "call", which
121
// may allow better inlining.
122
boolean procSafeForMultipleEvaluation = ! proc.side_effects();
123
124     // First an outer (let ((%proc PROC)) L2), where PROC is args[0].
125
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     // Then an inner L2=(let ((%loop (lambda (argi ...) ...))) (%loop ...))
133
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     // Finally an inner L3=(let ((parg1 (as <pair> arg1)) ...) ...)
142
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 JavaDoc 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