001: package kawa.standard;
002:
003: import gnu.lists.*;
004: import gnu.mapping.*;
005: import gnu.expr.*;
006: import gnu.kawa.functions.IsEq;
007: import gnu.kawa.reflect.Invoke;
008: import gnu.kawa.reflect.SlotGet;
009:
010: /** Implement the Scheme standard functions "map" and "for-each".
011: * @author Per Bothner
012: */
013:
014: public class map extends gnu.mapping.ProcedureN implements CanInline {
015: /** True if we should collect the result into a list. */
016: boolean collect;
017:
018: public map(boolean collect) {
019: super (collect ? "map" : "for-each");
020: this .collect = collect;
021: }
022:
023: /** An optimized single-list version of map. */
024: static public Object map1(Procedure proc, Object list)
025: throws Throwable {
026: Object result = LList.Empty;
027: Pair last = null;
028: while (list != LList.Empty) {
029: Pair pair = (Pair) list;
030: Pair new_pair = new Pair(proc.apply1(pair.car), LList.Empty);
031: if (last == null)
032: result = new_pair;
033: else
034: last.cdr = new_pair;
035: last = new_pair;
036: list = pair.cdr;
037: }
038: return result;
039: }
040:
041: /** An optimized single-list version of for-each. */
042: static public void forEach1(Procedure proc, Object list)
043: throws Throwable {
044: while (list != LList.Empty) {
045: Pair pair = (Pair) list;
046: proc.apply1(pair.car);
047: list = pair.cdr;
048: }
049: }
050:
051: public Object apply2(Object arg1, Object arg2) throws Throwable {
052: Procedure proc = (Procedure) arg1;
053: if (collect)
054: return map1(proc, arg2);
055: forEach1(proc, arg2);
056: return Values.empty;
057: }
058:
059: public Object applyN(Object[] args) throws Throwable {
060: Procedure proc = (Procedure) (args[0]);
061: int arity = args.length - 1;
062: if (arity == 1) {
063: if (collect)
064: return map1(proc, args[1]);
065: forEach1(proc, args[1]);
066: return Values.empty;
067: }
068: Object result;
069: Pair last = null;
070: if (collect)
071: result = LList.Empty;
072: else
073: result = Values.empty;
074: ;
075: Object[] rest = new Object[arity];
076: System.arraycopy(args, 1, rest, 0, arity);
077: Object[] each_args = new Object[arity];
078: for (;;) {
079: for (int i = 0; i < arity; i++) {
080: Object list = rest[i];
081: if (list == LList.Empty)
082: return result;
083: Pair pair = (Pair) list;
084: each_args[i] = pair.car;
085: rest[i] = pair.cdr;
086: }
087: Object value = proc.applyN(each_args);
088: if (collect) {
089: Pair new_pair = new Pair(value, LList.Empty);
090: if (last == null)
091: result = new_pair;
092: else
093: last.cdr = new_pair;
094: last = new_pair;
095: }
096: }
097: }
098:
099: public Expression inline(ApplyExp exp, ExpWalker walker) {
100: Expression[] args = exp.getArgs();
101: int nargs = args.length;
102: if (nargs < 2)
103: return exp; // ERROR
104:
105: InlineCalls inliner = (InlineCalls) walker;
106:
107: nargs--;
108:
109: Expression proc = args[0];
110: // If evaluating proc doesn't have side-effects, then we want to do
111: // so inside loop, since that turns a "read" info a "call", which
112: // may allow better inlining.
113: boolean procSafeForMultipleEvaluation = !proc.side_effects();
114:
115: // First an outer (let ((%proc PROC)) L2), where PROC is args[0].
116: Expression[] inits1 = new Expression[1];
117: inits1[0] = proc;
118: LetExp let1 = new LetExp(inits1);
119: Declaration procDecl = let1.addDeclaration("%proc",
120: Compilation.typeProcedure);
121: procDecl.noteValue(args[0]);
122:
123: // Then an inner L2=(let ((%loop (lambda (argi ...) ...))) (%loop ...))
124: Expression[] inits2 = new Expression[1];
125: LetExp let2 = new LetExp(inits2);
126: let1.setBody(let2);
127: LambdaExp lexp = new LambdaExp(collect ? nargs + 1 : nargs);
128: inits2[0] = lexp;
129: Declaration loopDecl = let2.addDeclaration("%loop");
130: loopDecl.noteValue(lexp);
131:
132: // Finally an inner L3=(let ((parg1 (as <pair> arg1)) ...) ...)
133: Expression[] inits3 = new Expression[nargs];
134: LetExp let3 = new LetExp(inits3);
135:
136: Declaration[] largs = new Declaration[nargs];
137: Declaration[] pargs = new Declaration[nargs];
138: IsEq isEq = Scheme.isEq;
139: for (int i = 0; i < nargs; i++) {
140: String argName = "arg" + i;
141: largs[i] = lexp.addDeclaration(argName);
142: pargs[i] = let3.addDeclaration(argName,
143: Compilation.typePair);
144: inits3[i] = new ReferenceExp(largs[i]);
145: pargs[i].noteValue(inits3[i]);
146: }
147: Declaration resultDecl = collect ? lexp
148: .addDeclaration("result") : null;
149:
150: Expression[] doArgs = new Expression[nargs];
151: Expression[] recArgs = new Expression[collect ? nargs + 1
152: : nargs];
153: for (int i = 0; i < nargs; i++) {
154: doArgs[i] = inliner.walkApplyOnly(SlotGet.makeGetField(
155: new ReferenceExp(pargs[i]), "car"));
156: recArgs[i] = inliner.walkApplyOnly(SlotGet.makeGetField(
157: new ReferenceExp(pargs[i]), "cdr"));
158: }
159: if (!procSafeForMultipleEvaluation)
160: proc = new ReferenceExp(procDecl);
161: Expression doit = inliner.walkApplyOnly(new ApplyExp(proc,
162: doArgs));
163: Expression rec = inliner.walkApplyOnly(new ApplyExp(
164: new ReferenceExp(loopDecl), recArgs));
165: if (collect) {
166: Expression[] consArgs = new Expression[2];
167: consArgs[0] = doit;
168: consArgs[1] = new ReferenceExp(resultDecl);
169: recArgs[nargs] = Invoke.makeInvokeStatic(
170: Compilation.typePair, "make", consArgs);
171: lexp.body = rec;
172: } else {
173: lexp.body = new BeginExp(doit, rec);
174: }
175: let3.setBody(lexp.body);
176: lexp.body = let3;
177: Expression[] initArgs = new Expression[collect ? nargs + 1
178: : nargs];
179: QuoteExp empty = new QuoteExp(LList.Empty);
180: for (int i = nargs; --i >= 0;) {
181: Expression[] compArgs = new Expression[2];
182: compArgs[0] = new ReferenceExp(largs[i]);
183: compArgs[1] = empty;
184: Expression result = collect ? (Expression) new ReferenceExp(
185: resultDecl)
186: : (Expression) QuoteExp.voidExp;
187: lexp.body = new IfExp(inliner.walkApplyOnly(new ApplyExp(
188: isEq, compArgs)), result, lexp.body);
189: initArgs[i] = args[i + 1];
190: }
191: if (collect)
192: initArgs[nargs] = empty;
193:
194: Expression body = inliner.walkApplyOnly(new ApplyExp(
195: new ReferenceExp(loopDecl), initArgs));
196: if (collect) {
197: Expression[] reverseArgs = new Expression[1];
198: reverseArgs[0] = body;
199: body = Invoke.makeInvokeStatic(Compilation.scmListType,
200: "reverseInPlace", reverseArgs);
201: }
202: let2.setBody(body);
203:
204: if (procSafeForMultipleEvaluation)
205: return let2;
206: else
207: return let1;
208: }
209: }
|