diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/compiler.boot | 101 | ||||
| -rw-r--r-- | src/interp/fnewmeta.lisp | 16 | ||||
| -rw-r--r-- | src/interp/functor.boot | 2 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 4 | ||||
| -rw-r--r-- | src/interp/lisp-backend.boot | 42 |
5 files changed, 107 insertions, 58 deletions
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index c85d1e9f..1dc074ce 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -2306,7 +2306,7 @@ localReferenceIfThere m == massageLoop x == main x where main x == x isnt ['CATCH,tag,['REPEAT,:iters,body]] => x - $mayHaveFreeIteratorVariables or CONTAINED('TAGGEDexit,x) => x + CONTAINED('TAGGEDexit,x) => x replaceThrowWithLeave(body,tag) containsNonLocalControl?(body,nil) => systemErrorHere ['massageLoop,x] ['CATCH,tag,['%loop,:iters,body,'%nil]] @@ -2339,7 +2339,6 @@ compRepeatOrCollect(form,m,e) == $iterateCount: local := 0 $loopBodyTag: local := nil $breakCount: local := 0 - $mayHaveFreeIteratorVariables: local := false oldEnv := e aggr := nil [$loopKind,:itl,body]:= form @@ -2399,6 +2398,28 @@ joinIntegerModes(x,y,e) == isSubset(y,x,e) => x $Integer +++ Given a for-loop iterator `x', return +++ a. its storage class +++ b. its name +++ c. an environment containing its declaration in case a type +++ was specified. +classifyIteratorVariable(x,e) == check(main(x,e),x) where + main(x,e) == + x is [":",var,t] => + not ident? var => nil + checkVariableName var + t is 'local => ['%local,var,e] + t is 'free => ['%free,var,e] + [.,.,e] := compMakeDeclaration(var,t,e) => ['%local,var,e] + nil + ident? x => + checkVariableName x + ['%local,x,e] + nil + check(x,y) == + x ~= nil => x + stackAndThrow('"invalid loop variable %1bp",[y]) + ++ Subroutine of compStepIterator. ++ We are elaborating the STEP form of a for-iterator, where all ++ bounds and increment are expected to be integer-valued expressions. @@ -2427,21 +2448,13 @@ compIntegerValue(x,e) == comp(x,$NonNegativeInteger,e) or compOrCroak(x,$Integer,e) -++ Issue a diagnostic if `x' names a loop variable with a matching -++ declaration or definition in the enclosing scope. -complainIfShadowing(x,e) == - $loopKind = 'COLLECT => nil -- collect loop variables always shadow - if getmode(x,e) ~= nil then - $mayHaveFreeIteratorVariables := true -- bound in compRepeatOrCollect - stackWarning('"loop variable %1b shadows variable from enclosing scope",[x]) - ++ Attempt to compile a `for' iterator of the form ++ for index in start..final by inc ++ where the bound `final' may be missing. compStepIterator(index,start,final,inc,e) == - checkVariableName index - complainIfShadowing(index,e) - $formalArgList := [index,:$formalArgList] + [sc,index,e] := classifyIteratorVariable(index,e) + if sc = '%local then + $formalArgList := [index,:$formalArgList] [start,startMode,e] := compIntegerValue(start,e) or return stackMessage('"start value of index: %1b must be an integer",[start]) [inc,incMode,e] := compIntegerValue(inc,e) or return @@ -2456,38 +2469,42 @@ compStepIterator(index,start,final,inc,e) == if get(index,"mode",e) = nil then [.,.,e] := compMakeDeclaration(index,indexMode,e) or return nil e := giveVariableSomeValue(index,indexMode,e) - [["STEP",index,start,inc,:final],e] + [["STEP",[sc,:index],start,inc,:final],e] +compINIterator(x,y,e) == + [sc,x,e] := classifyIteratorVariable(x,e) + --these two lines must be in this order, to get "for f in list f" + --to give an error message if f is undefined + [y',m,e]:= comp(y,$EmptyMode,e) or return nil + if sc = '%local then + $formalArgList := [x,:$formalArgList] + [mOver,mUnder]:= + modeIsAggregateOf("List",m,e) or return + stackMessage('"mode: %1pb must be a list of some mode",[m]) + if null get(x,"mode",e) then [.,.,e]:= + compMakeDeclaration(x,mUnder,e) or return nil + e:= giveVariableSomeValue(x,mUnder,e) + [y'',m'',e] := coerce([y',m,e], mOver) or return nil + [["IN",[sc,:x],y''],e] + +compONIterator(x,y,e) == + [sc,x,e] := classifyIteratorVariable(x,e) + if sc = '%local then + $formalArgList := [x,:$formalArgList] + [y',m,e]:= comp(y,$EmptyMode,e) or return nil + [mOver,mUnder]:= + modeIsAggregateOf("List",m,e) or return + stackMessage('"mode: %1pb must be a list of other modes",[m]) + if null get(x,"mode",e) then [.,.,e]:= + compMakeDeclaration(x,m,e) or return nil + e:= giveVariableSomeValue(x,m,e) + [y'',m'',e] := coerce([y',m,e], mOver) or return nil + [["ON",[sc,:x],y''],e] + compIterator(it,e) == -- ??? Allow for declared iterator variable. - it is ["IN",x,y] => - checkVariableName x - complainIfShadowing(x,e) - --these two lines must be in this order, to get "for f in list f" - --to give an error message if f is undefined - [y',m,e]:= comp(y,$EmptyMode,e) or return nil - $formalArgList:= [x,:$formalArgList] - [mOver,mUnder]:= - modeIsAggregateOf("List",m,e) or return - stackMessage('"mode: %1pb must be a list of some mode",[m]) - if null get(x,"mode",e) then [.,.,e]:= - compMakeDeclaration(x,mUnder,e) or return nil - e:= giveVariableSomeValue(x,mUnder,e) - [y'',m'',e] := coerce([y',m,e], mOver) or return nil - [["IN",x,y''],e] - it is ["ON",x,y] => - checkVariableName x - complainIfShadowing(x,e) - $formalArgList:= [x,:$formalArgList] - [y',m,e]:= comp(y,$EmptyMode,e) or return nil - [mOver,mUnder]:= - modeIsAggregateOf("List",m,e) or return - stackMessage('"mode: %1pb must be a list of other modes",[m]) - if null get(x,"mode",e) then [.,.,e]:= - compMakeDeclaration(x,m,e) or return nil - e:= giveVariableSomeValue(x,m,e) - [y'',m'',e] := coerce([y',m,e], mOver) or return nil - [["ON",x,y''],e] + it is ["IN",x,y] => compINIterator(x,y,e) + it is ["ON",x,y] => compONIterator(x,y,e) it is ["STEP",index,start,inc,:optFinal] => compStepIterator(index,start,optFinal,inc,e) it is ["WHILE",p] => diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp index f1cd15e0..28c9e03c 100644 --- a/src/interp/fnewmeta.lisp +++ b/src/interp/fnewmeta.lisp @@ -263,7 +263,7 @@ (MUST (MATCH-ADVANCE-STRING ")")))) (DEFUN |PARSE-QuantifiedVariable| () - (AND (PARSE-IDENTIFIER) + (AND (|PARSE-Name|) (MUST (MATCH-ADVANCE-STRING ":")) (MUST (|PARSE-Application|)) (MUST (PUSH-REDUCTION '|PARSE-QuantifiedVariable| @@ -437,8 +437,18 @@ (CONS 'REPEAT (CONS (POP-STACK-1) NIL)))))) +(DEFUN |PARSE-Variable| () + (OR (AND (|PARSE-Name|) + (OPTIONAL (AND (MATCH-ADVANCE-STRING ":") + (MUST (|PARSE-Application|)) + (MUST (PUSH-REDUCTION '|PARSE-Variable| + (CONS '|:| + (CONS (POP-STACK-2) + (CONS (POP-STACK-1) NIL)))))))) + (|PARSE-Primary|))) + (DEFUN |PARSE-Iterator| () - (OR (AND (MATCH-ADVANCE-KEYWORD "for") (MUST (|PARSE-Primary|)) + (OR (AND (MATCH-ADVANCE-KEYWORD "for") (MUST (|PARSE-Variable|)) (MUST (MATCH-ADVANCE-KEYWORD "in")) (MUST (|PARSE-Expression|)) (MUST (OR (AND (MATCH-ADVANCE-KEYWORD "by") @@ -792,7 +802,7 @@ (DEFUN |PARSE-AnyId| () - (OR (PARSE-IDENTIFIER) + (OR (|PARSE-Name|) (OR (AND (MATCH-STRING "$") (PUSH-REDUCTION '|PARSE-AnyId| (CURRENT-SYMBOL)) (ACTION (ADVANCE-TOKEN))) diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 8c6fc79c..be229149 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -284,7 +284,7 @@ optFunctorBody x == first pred="HasCategory" => nil ['%when,:l] ['%when,:l] - [optFunctorBody u for u in x] + [optFunctorBody first x,:optFunctorBody rest x] optFunctorBodyQuotable u == u = nil or integer? u or string? u => true diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 69c333e3..f644ddda 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -624,7 +624,9 @@ optCollectVector form == -- pick a loop variable that we can use as the loop index. [.,var,lo,inc,:etc] := iter if lo = 0 and inc = 1 then - index := var + index := + var is [.,:var'] => var' + var if [hi] := etc then sz := inc = 1 => diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot index 36075241..6354a5cf 100644 --- a/src/interp/lisp-backend.boot +++ b/src/interp/lisp-backend.boot @@ -55,27 +55,39 @@ module lisp_-backend where --% 3. predicate guarding loop body execution --% 4. loop termination predicate +++ Dummy free var name. +$freeVarName == KEYWORD::freeVar + +loopVarInit(x,y) == + x is ['%free,:id] => [id,[$freeVarName,middleEndExpand ['%LET,id,y]]] + if x is ['%local,:.] then + x := x.rest + [x,[x,middleEndExpand y]] + ++ Generate code that sequentially visits each component of a list. expandIN(x,l,early?) == g := gensym() -- rest of the list yet to be visited early? => -- give the loop variable a wider scope. - [[[g,middleEndExpand l],[x,'NIL]], + [x,init] := loopVarInit(x,'%nil) + [[[g,middleEndExpand l],init], nil,[['SETQ,g,['CDR,g]]], nil,[['NOT,['CONSP,g]],['PROGN,['SETQ,x,['CAR,g]],'NIL]]] + [x,init] := loopVarInit(x,['%head,g]) [[[g,middleEndExpand l]], - [[x,['CAR,g]]],[['SETQ,g,['CDR,g]]], + [init],[['SETQ,g,['CDR,g]]], nil,[['NOT,['CONSP,g]]]] expandON(x,l) == - [[[x,middleEndExpand l]],nil,[["SETQ",x,["CDR",x]]],nil,[["ATOM",x]]] + [x,init] := loopVarInit(x,l) + [[init],nil,[["SETQ",x,["CDR",x]]],nil,[["ATOM",x]]] ++ Generate code that traverses an interval with lower bound 'lo', ++ arithmetic progression `step, and possible upper bound `final'. expandSTEP(id,lo,step,final)== - lo := middleEndExpand lo step := middleEndExpand step final := middleEndExpand final - loopvar := [[id,lo]] + [id,init] := loopVarInit(id,lo) + loopvar := [init] inc := atomic? step => step g1 := gensym() @@ -133,6 +145,16 @@ expandIterators iters == it is ["%init",var,val] => expandInit(var,val) nil +massageFreeVarInits(body,inits) == + inits = nil => body + inits is [[var,init]] and sameObject?(var,$freeVarName) => + ['SEQ,init,['EXIT,body]] + for init in inits repeat + sameObject?(init.first,$freeVarName) => + init.first := gensym() + ['LET,inits,body] + + expandLoop ['%loop,:iters,body,ret] == itersCode := expandIterators iters itersCode = "failed" => systemErrorHere ["expandLoop",iters] @@ -145,25 +167,23 @@ expandLoop ['%loop,:iters,body,ret] == if filters ~= nil then body := mkpf([:filters,body],"AND") -- If there is any body-wide initialization, now is the time. - if bodyInits ~= nil then - body := ["LET",bodyInits,body] + body := massageFreeVarInits(body,bodyInits) exits := ["COND", [mkpf(exits,"OR"),["RETURN",expandToVMForm ret]], [true,body]] body := ["LOOP",exits,:cont] -- Finally, set up loop-wide initializations. - loopInits = nil => body - ["LET",loopInits,body] + massageFreeVarInits(body,loopInits) ++ Generate code for list comprehension. expandCollect ['%collect,:iters,body] == val := gensym() -- result of the list comprehension -- Transform the body to build the list as we go. - body := ["SETQ",val,["CONS",middleEndExpand body,val]] + body := ['%store,val,['%pair,body,val]] -- Initialize the variable holding the result; expand as -- if ordinary loop. But don't forget we built the result -- in reverse order. - expandLoop ['%loop,:iters,["%init",val,nil],body,["reverse!",val]] + expandLoop ['%loop,:iters,["%init",val,nil],body,['%lreverse!,val]] expandList(x is ['%list,:args]) == args := [expandToVMForm arg for arg in args] |