diff options
author | dos-reis <gdr@axiomatics.org> | 2011-08-14 21:23:34 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-08-14 21:23:34 +0000 |
commit | 7dff09b8cac803d6936887fdfa286a2a25073ac2 (patch) | |
tree | 1f82b9c5f57145f6f2234617bb35503666f0b2dc | |
parent | 775f2c3cca11ab64df713afb7f35363afe5d4ce0 (diff) | |
download | open-axiom-7dff09b8cac803d6936887fdfa286a2a25073ac2.tar.gz |
* interp/lisp-backend.boot ($freeVarName): New global constant.
(loopVarInit): New.
(expandIN): Use it.
(expandON): Likewise.
(expandSTEP): Likewise.
(massageFreeVarInits): New.
(expandLoop): Use it.
* interp/fnewmeta.lisp (PARSE-QuantifiedVariable): Tidy.
(PARSE-AnyId): Likewise.
(PARSE-Variable): New. Allow scope-of-type specification for
loop variable.
(PARSE-Iterator): Use it.
* interp/compiler.boot (massage_llop): Don't check
$mayHaveFreeIteratorVariables.
(compRepeatOrCollect): Don't bind it.
(classifyIteratorVariable): New.
(complainIfShadowing): Remove as no longer needed.
(compStepIterator): Use it. Tidy.
(compONIterator, compINIterator): New. Split out of compIterator.
(compIterator): Refactor.
* interp/functor.boot (optFunctorBody): Fix thinko.
* interp/g-opt.boot (optCollectVector): A STEP iterator may have a
storage class.
* algebra/clip.spad.pamphlet: Fix loop variable scope.
* algebra/ffpoly.spad.pamphlet: Likewise.
* algebra/fparfrac.spad.pamphlet: Likewise.
* algebra/gdpoly.spad.pamphlet: Likewise.
* algebra/ghensel.spad.pamphlet: Likewise.
* algebra/groebsol.spad.pamphlet: Likewise.
* algebra/intfact.spad.pamphlet: Likewise.
* algebra/matfuns.spad.pamphlet: Likewise.
* algebra/moddfact.spad.pamphlet: Likewise.
* algebra/numtheor.spad.pamphlet: Likewise.
* algebra/permgrps.spad.pamphlet: Likewise.
* algebra/pfbr.spad.pamphlet: Likewise.
* algebra/pgcd.spad.pamphlet: Likewise.
* algebra/pleqn.spad.pamphlet: Likewise.
* algebra/pseudolin.spad.pamphlet: Likewise.
* algebra/radeigen.spad.pamphlet: Likewise.
* algebra/radix.spad.pamphlet: Likewise.
* algebra/regset.spad.pamphlet: Likewise.
* algebra/rep2.spad.pamphlet: Likewise.
* algebra/sgcf.spad.pamphlet: Likewise.
* algebra/smith.spad.pamphlet: Likewise.
* algebra/sregset.spad.pamphlet: Likewise.
* algebra/syssolp.spad.pamphlet: Likewise.
* algebra/zerodim.spad.pamphlet: Likewise.
* algebra/crfp.spad.pamphlet: Remove capsule-level declaration of
local variables.
* algebra/galfact.spad.pamphlet: Likewise.
* algebra/mathml.spad.pamphlet: Likewise.
* algebra/numode.spad.pamphlet: Likewise.
* algebra/tex.spad.pamphlet: Likewise.
* algebra/updecomp.spad.pamphlet: Likewise.
36 files changed, 223 insertions, 134 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index f283ff44..c933bf9b 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,61 @@ +2011-08-14 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/lisp-backend.boot ($freeVarName): New global constant. + (loopVarInit): New. + (expandIN): Use it. + (expandON): Likewise. + (expandSTEP): Likewise. + (massageFreeVarInits): New. + (expandLoop): Use it. + * interp/fnewmeta.lisp (PARSE-QuantifiedVariable): Tidy. + (PARSE-AnyId): Likewise. + (PARSE-Variable): New. Allow scope-of-type specification for + loop variable. + (PARSE-Iterator): Use it. + * interp/compiler.boot (massage_llop): Don't check + $mayHaveFreeIteratorVariables. + (compRepeatOrCollect): Don't bind it. + (classifyIteratorVariable): New. + (complainIfShadowing): Remove as no longer needed. + (compStepIterator): Use it. Tidy. + (compONIterator, compINIterator): New. Split out of compIterator. + (compIterator): Refactor. + * interp/functor.boot (optFunctorBody): Fix thinko. + * interp/g-opt.boot (optCollectVector): A STEP iterator may have a + storage class. + + * algebra/clip.spad.pamphlet: Fix loop variable scope. + * algebra/ffpoly.spad.pamphlet: Likewise. + * algebra/fparfrac.spad.pamphlet: Likewise. + * algebra/gdpoly.spad.pamphlet: Likewise. + * algebra/ghensel.spad.pamphlet: Likewise. + * algebra/groebsol.spad.pamphlet: Likewise. + * algebra/intfact.spad.pamphlet: Likewise. + * algebra/matfuns.spad.pamphlet: Likewise. + * algebra/moddfact.spad.pamphlet: Likewise. + * algebra/numtheor.spad.pamphlet: Likewise. + * algebra/permgrps.spad.pamphlet: Likewise. + * algebra/pfbr.spad.pamphlet: Likewise. + * algebra/pgcd.spad.pamphlet: Likewise. + * algebra/pleqn.spad.pamphlet: Likewise. + * algebra/pseudolin.spad.pamphlet: Likewise. + * algebra/radeigen.spad.pamphlet: Likewise. + * algebra/radix.spad.pamphlet: Likewise. + * algebra/regset.spad.pamphlet: Likewise. + * algebra/rep2.spad.pamphlet: Likewise. + * algebra/sgcf.spad.pamphlet: Likewise. + * algebra/smith.spad.pamphlet: Likewise. + * algebra/sregset.spad.pamphlet: Likewise. + * algebra/syssolp.spad.pamphlet: Likewise. + * algebra/zerodim.spad.pamphlet: Likewise. + * algebra/crfp.spad.pamphlet: Remove capsule-level declaration of + local variables. + * algebra/galfact.spad.pamphlet: Likewise. + * algebra/mathml.spad.pamphlet: Likewise. + * algebra/numode.spad.pamphlet: Likewise. + * algebra/tex.spad.pamphlet: Likewise. + * algebra/updecomp.spad.pamphlet: Likewise. + 2011-08-13 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/compiler.boot (compRepeatOrCollect): Set $loopKind directly. diff --git a/src/algebra/clip.spad.pamphlet b/src/algebra/clip.spad.pamphlet index 6804f0ab..1d343412 100644 --- a/src/algebra/clip.spad.pamphlet +++ b/src/algebra/clip.spad.pamphlet @@ -279,7 +279,7 @@ TwoDimensionalPlotClipping(): Exports == Implementation where xMin : SF := xCoord firstPt; xMax : SF := xCoord firstPt yMin : SF := yCoord firstPt; yMax : SF := yCoord firstPt for list in lists repeat - for pt in list repeat + for pt: local in list repeat if not Pnan? pt then xMin := min(xMin,xCoord pt) xMax := max(xMax,xCoord pt) diff --git a/src/algebra/crfp.spad.pamphlet b/src/algebra/crfp.spad.pamphlet index 8bbd8ee9..9f61ed5d 100644 --- a/src/algebra/crfp.spad.pamphlet +++ b/src/algebra/crfp.spad.pamphlet @@ -162,7 +162,6 @@ ComplexRootFindingPackage(R, UP): public == private where Rep := ModMonic(C, UP) -- constants - c : C r : R --globalDigits : I := 10 ** 41 globalDigits : I := 10 ** 7 diff --git a/src/algebra/ffpoly.spad.pamphlet b/src/algebra/ffpoly.spad.pamphlet index c4f0c586..cc219171 100644 --- a/src/algebra/ffpoly.spad.pamphlet +++ b/src/algebra/ffpoly.spad.pamphlet @@ -437,7 +437,7 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where -- the input(!) f would be modified by assigning -- a new value to one of its records term : Rec - for term in fRepr repeat + for term: free in fRepr repeat fcopy := cons(copy term, fcopy) if term.expnt ~= 0 then fcopy := cons([0,0]$Rec, fcopy) @@ -515,7 +515,7 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where -- the input(!) f would be modified by assigning -- a new value to one of its records term : Rec - for term in fRepr repeat + for term: free in fRepr repeat fcopy := cons(copy term, fcopy) if term.expnt ~= 0 then term := [0,0]$Rec @@ -635,7 +635,7 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where -- the input(!) f would be modified by assigning -- a new value to one of its records term : Rec - for term in fRepr repeat + for term: free in fRepr repeat fcopy := cons(copy term, fcopy) if term.expnt ~= 0 then term := [0,0]$Rec @@ -749,7 +749,7 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where -- the input(!) f would be modified by assigning -- a new value to one of its records term : Rec - for term in fRepr repeat + for term: free in fRepr repeat fcopy := cons(copy term, fcopy) if term.expnt ~= 0 then term := [0,0]$Rec diff --git a/src/algebra/fparfrac.spad.pamphlet b/src/algebra/fparfrac.spad.pamphlet index f6495e21..e735bce9 100644 --- a/src/algebra/fparfrac.spad.pamphlet +++ b/src/algebra/fparfrac.spad.pamphlet @@ -160,7 +160,7 @@ FullPartialFractionExpansion(F, UP): Exports == Implementation where empty? l => empty() rec := first l ans := output(rec.exponent, rec.center, rec.num) - for rec in rest l repeat + for rec: local in rest l repeat ans := ans + output(rec.exponent, rec.center, rec.num) ans diff --git a/src/algebra/galfact.spad.pamphlet b/src/algebra/galfact.spad.pamphlet index 43d4e9cb..edce7558 100644 --- a/src/algebra/galfact.spad.pamphlet +++ b/src/algebra/galfact.spad.pamphlet @@ -310,11 +310,10 @@ GaloisGroupFactorizer(UP): Exports == Implementation where ddlist: DDList := empty() degfact: N := 0 nf: N := stopmussertrials+1 - i: Z -- Musser, see [3] -- diffp := differentiate p - for i in 1..mussertrials | nf>stopmussertrials repeat + for i: Z in 1..mussertrials | nf>stopmussertrials repeat -- test 1: cprime divides leading coefficient -- test 2: "bad" primes: (in future: use Dedekind's Criterion) while (zero? ((leadingCoefficient p) rem cprime)) or diff --git a/src/algebra/gdpoly.spad.pamphlet b/src/algebra/gdpoly.spad.pamphlet index e477aa04..23a6a1f4 100644 --- a/src/algebra/gdpoly.spad.pamphlet +++ b/src/algebra/gdpoly.spad.pamphlet @@ -107,8 +107,7 @@ GeneralDistributedMultivariatePolynomial(vl,R,E): public == private where if R has OrderedRing then maxNorm(p : %): R == l : List R := nil - r,m : R - m := 0 + m: R := 0 for r in listCoef(p) repeat if r > m then m := r else if (-r) > m then m := -r diff --git a/src/algebra/ghensel.spad.pamphlet b/src/algebra/ghensel.spad.pamphlet index 64ff2a89..c89d966a 100644 --- a/src/algebra/ghensel.spad.pamphlet +++ b/src/algebra/ghensel.spad.pamphlet @@ -147,7 +147,7 @@ GeneralHenselPackage(RP,TP):C == T where finallist := cons(poly1,finallist) dfn := degree m aux := [] - for poly in fln repeat + for poly: local in fln repeat not member?(poly,auxl) => aux := cons(poly,aux) auxfl := [term for term in auxfl | not member?(poly,term)] factlist := [term for term in factlist | not member?(poly,term)] diff --git a/src/algebra/groebsol.spad.pamphlet b/src/algebra/groebsol.spad.pamphlet index 95af1daf..eedaa3bb 100644 --- a/src/algebra/groebsol.spad.pamphlet +++ b/src/algebra/groebsol.spad.pamphlet @@ -89,7 +89,7 @@ GroebnerSolve(lv,F,R) : C == T #lvar=1 => [f] rlvar:=rest reverse lvar newlpol:List(DPoly):=[f] - for f in rlpol.rest repeat + for f: local in rlpol.rest repeat x:=first rlvar fi:= univariate(f,x) if (mainVariable leadingCoefficient fi case "failed") then diff --git a/src/algebra/intfact.spad.pamphlet b/src/algebra/intfact.spad.pamphlet index 4c4be09d..f405476f 100644 --- a/src/algebra/intfact.spad.pamphlet +++ b/src/algebra/intfact.spad.pamphlet @@ -152,7 +152,7 @@ IntegerPrimesPackage(I:IntegerNumberSystem): with nm1 := n-1 q := (nm1) quo two k : NonNegativeInteger - for k in 1.. while not odd? q repeat q := q quo two + for k: free in 1.. while not odd? q repeat q := q quo two -- q = (n-1) quo 2**k for largest possible k n < JaeschkeLimit => @@ -458,7 +458,7 @@ IntegerFactorizationPackage(I): Exports == Implementation where if n>1 then ls := concat!(ls, ["prime",n,1]$FFE) return makeFR(1, ls) m : Integer - for m in 0.. while zero?(n rem d) repeat n := n quo d + for m: free in 0.. while zero?(n rem d) repeat n := n quo d if positive? m then ls := concat!(ls, ["prime",d,convert m]$FFE) d := d+s @@ -497,7 +497,7 @@ IntegerFactorizationPackage(I): Exports == Implementation where insert!(x-y,a,c) (d := PollardSmallFactor20 n) case I => m' : NonNegativeInteger - for m' in 0.. while zero?(n rem d) repeat n := n quo d + for m': free in 0.. while zero?(n rem d) repeat n := n quo d insert!(d, a, m' * c) if n > 1 then insert!(n, a, c) -- an elliptic curve factorization attempt should be made here diff --git a/src/algebra/matfuns.spad.pamphlet b/src/algebra/matfuns.spad.pamphlet index 47cc96e3..cf739082 100644 --- a/src/algebra/matfuns.spad.pamphlet +++ b/src/algebra/matfuns.spad.pamphlet @@ -149,7 +149,7 @@ InnerMatrixLinearAlgebraFunctions(R,Row,Col,M):_ v : IndexedOneDimensionalArray(I,minC) := new(ncol,minR - 1) j : Integer for i in minR..(minR + rk - 1) repeat - for j in minC.. while qelt(x,i,j) = 0 repeat j + for j: free in minC.. while qelt(x,i,j) = 0 repeat j qsetelt!(v,j,i) j := maxC; l := minR + ncol - 1 while j >= minC repeat @@ -186,7 +186,7 @@ InnerMatrixLinearAlgebraFunctions(R,Row,Col,M):_ swapRows!(x,i,rown); ans := -ans ans := qelt(x,i,j) * ans; b := -inv qelt(x,i,j) for l in (j+1)..maxC repeat qsetelt!(x,i,l,b * qelt(x,i,l)) - for k in (i+1)..maxR repeat + for k: local in (i+1)..maxR repeat if (b := qelt(x,k,j)) ~= 0 then for l in (j+1)..maxC repeat qsetelt!(x,k,l,qelt(x,k,l) + b * qelt(x,i,l)) @@ -587,7 +587,7 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where swapRows!(x,i,rown) ans := -ans (c := qelt(x,i,j)) = 0 => "next j" -- try next column - for k in (i+1)..maxR repeat + for k: local in (i+1)..maxR repeat if qelt(x,k,j) = 0 then for l in (j+1)..maxC repeat qsetelt!(x,k,l,(c * qelt(x,k,l) exquo b) :: R) diff --git a/src/algebra/mathml.spad.pamphlet b/src/algebra/mathml.spad.pamphlet index b40ed836..396a958b 100644 --- a/src/algebra/mathml.spad.pamphlet +++ b/src/algebra/mathml.spad.pamphlet @@ -587,7 +587,6 @@ returning Void. I really only need the one coerce function. -- This breaks down an expression into atoms and returns it as -- a string. It's for developmental purposes to help understand -- the expressions. - a : E expr := precondition expr -- sayTeX$Lisp "0: "stringify expr (not %pair?(expr)$Foreign(Builtin)) or (stringify expr = "NOTHING") => @@ -749,7 +748,6 @@ have to be switched by swapping names. -- This breaks down an expression into a flat list of atomic expressions. -- expr should be preconditioned. le : L E := nil() - a : E letmp : L E (not %pair?(expr)$Foreign(Builtin)) or (stringify expr = "NOTHING") => le := append(le,list(expr)) diff --git a/src/algebra/moddfact.spad.pamphlet b/src/algebra/moddfact.spad.pamphlet index 9cf3d902..d4d61526 100644 --- a/src/algebra/moddfact.spad.pamphlet +++ b/src/algebra/moddfact.spad.pamphlet @@ -179,7 +179,7 @@ ModularDistinctDegreeFactorizer(U):C == T where x:U:= monomial(1,1) -- for small primes find linear factors by exhaustion d=1 and p < 1000 => - for i in 0.. while positive? du repeat + for i: local in 0.. while positive? du repeat if u(i::U) = 0 then ans := cons(reduce(x-(i::U),p),ans) du := du-1 diff --git a/src/algebra/numode.spad.pamphlet b/src/algebra/numode.spad.pamphlet index b602916c..3c0f0ff5 100644 --- a/src/algebra/numode.spad.pamphlet +++ b/src/algebra/numode.spad.pamphlet @@ -310,7 +310,6 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where ynew : V NF := new(nvar::NNI,0.0) h : NF := (x2-x1) / (nstep::NF) x : NF := x1 - i : I j : I -- start integrating for i in 1..nstep repeat diff --git a/src/algebra/numtheor.spad.pamphlet b/src/algebra/numtheor.spad.pamphlet index 0e40d82e..f1251618 100644 --- a/src/algebra/numtheor.spad.pamphlet +++ b/src/algebra/numtheor.spad.pamphlet @@ -654,7 +654,7 @@ PolynomialNumberTheoryFunctions(): Exports == Implementation where p laguerre n == - k:I; s:I; t:I; p:SUP(I); q:SUP(I) + s:I; t:I; p:SUP(I); q:SUP(I) negative? n => error "laguerre not defined for negative integers" -- (s,p,q) := if n < L.Ln then (0,1,x) else L if n < L.Ln then (s := 0; p := 1; q := x) else (s,p,q) := L diff --git a/src/algebra/permgrps.spad.pamphlet b/src/algebra/permgrps.spad.pamphlet index f3c8fa7d..6ca1efa4 100644 --- a/src/algebra/permgrps.spad.pamphlet +++ b/src/algebra/permgrps.spad.pamphlet @@ -346,7 +346,7 @@ PermutationGroup(S:SetCategory): public == private where ort: REC k1: NNI i : NNI - for i in number1..degree repeat + for i: free in number1..degree repeat ort := orbitWithSvc ( group , i ) k := ort.orb k1 := # k @@ -355,7 +355,7 @@ PermutationGroup(S:SetCategory): public == private where words2 := nil()$(L L NNI) gplength : NNI := #group jj: NNI - for jj in 1..gplength repeat if (group.jj).i ~= i then leave + for jj: free in 1..gplength repeat if (group.jj).i ~= i then leave for k in 1..gplength repeat el2 := group.k if el2.i ~= i then diff --git a/src/algebra/pfbr.spad.pamphlet b/src/algebra/pfbr.spad.pamphlet index 5fb79179..8ae314c3 100644 --- a/src/algebra/pfbr.spad.pamphlet +++ b/src/algebra/pfbr.spad.pamphlet @@ -466,7 +466,7 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public == -- pp1 is mathematically equal to pp, but is in S[z][v] -- so we wish to operate on all of its coefficients ans:List SupSupS:= [0 for u in lpolys] - for m in reverse! monomials pp1 repeat + for m: local in reverse! monomials pp1 repeat ans1:=SLPEBR(lpolys,lvpolys,leadingCoefficient m,lvpp) ans1 case "failed" => return "failed" d:=degree m diff --git a/src/algebra/pgcd.spad.pamphlet b/src/algebra/pgcd.spad.pamphlet index eb38b2c1..abe167c8 100644 --- a/src/algebra/pgcd.spad.pamphlet +++ b/src/algebra/pgcd.spad.pamphlet @@ -304,7 +304,7 @@ PolynomialGcdPackage(E,OV,R,P):C == T where listpol:=listpol.rest nolift:Boolean:=true uf: SUP - for uf in listpol repeat + for uf: free in listpol repeat --note uf and d not necessarily primitive degree gcd(uf,d) =0 => nolift:=false nolift => ["notCoprime"] diff --git a/src/algebra/pleqn.spad.pamphlet b/src/algebra/pleqn.spad.pamphlet index e3090a74..0e371880 100644 --- a/src/algebra/pleqn.spad.pamphlet +++ b/src/algebra/pleqn.spad.pamphlet @@ -315,7 +315,6 @@ ParametricLinearEquations(R,Var,Expon,GR): false B1solve (sys:Linsys):Linsoln == - i,j,i1,j1:I rss:L I:=sys.rows nss:L I:=sys.cols k:=sys.rank @@ -349,7 +348,6 @@ ParametricLinearEquations(R,Var,Expon,GR): [p,pbas] regime (y, coef, w, psbf, rk, rkmax, mode) == - i,j:I -- use the y.det nonzero to simplify the groebner basis -- of ideal generated by higher order subdeterminants ydetf:L GR:=factorset y.det @@ -396,8 +394,6 @@ ParametricLinearEquations(R,Var,Expon,GR): if filemode then newfile:=new$FNAME ("",outname,"regime") rksoln:=open$(File Rec3) newfile - y:Rec - k:NNI rrcl:RankConds:= entry? (mode,[1,2,3,7,8,9]$(L I)) => ParCondList (coeff,0) entry? (mode,[4,5,6,10,11,12]$(L I)) => ParCondList (coeff,h) @@ -409,7 +405,7 @@ ParametricLinearEquations(R,Var,Expon,GR): psb:Fgb:= (if rk=rkmax then [] else rrcl.(k+1).fgb) psbf:L L GR:= [factorset x for x in psb] psbf:= minset(psbf) - for y in pc repeat + for y: Rec in pc repeat rec3:Rec3:= regime (y, coeff, w, psbf, rk, rkmax, mode) inconsistent? rec3.wcond => "incompatible system" if filemode then write!(rksoln, rec3) @@ -428,13 +424,11 @@ ParametricLinearEquations(R,Var,Expon,GR): pc:Eqns:=[] npc: Eqns:=[] psbf: Fgb:=[] - rc: Rec done: Boolean := false r:=nrows mat n:=ncols mat maxrk:I:=min(r,n) - k:NNI - for k in min(r,n)..h by -1 until done repeat + for k: NNI in min(r,n)..h by -1 until done repeat pc:= ParCond(mat,k) npc:=[] (empty? pc) and (k >= 1) => maxrk:= k - 1 @@ -443,7 +437,7 @@ ParametricLinearEquations(R,Var,Expon,GR): else zro:L GR:= (if k = maxrk then [] else rcl.1.fgb) covered:Boolean:=false - for rc in pc until covered repeat + for rc: Rec in pc until covered repeat p:GR:= redPol$rp (rc.det, zro) p = 0 => "incompatible or covered subdeterminant" test:=hasoln(zro, [rc.det]) @@ -630,7 +624,6 @@ ParametricLinearEquations(R,Var,Expon,GR): redmat (mat,psb) == - i,j:I r:=nrows(mat) n:=ncols(mat) newmat: M GR:=zero(r,n) diff --git a/src/algebra/pseudolin.spad.pamphlet b/src/algebra/pseudolin.spad.pamphlet index 6d69f5f3..08d34c08 100644 --- a/src/algebra/pseudolin.spad.pamphlet +++ b/src/algebra/pseudolin.spad.pamphlet @@ -107,7 +107,7 @@ PseudoLinearNormalForm(K:Field): Exports == Implementation where M := changeBase(M, E, sig, der) B := B*E Binv := inv(E)*Binv - for j in 1..N repeat + for j: local in 1..N repeat if j ~= i+1 then E := addMatrix(N, i+1, j, siginv(-M(i,j))) M := changeBase(M, E, sig, der) @@ -116,7 +116,7 @@ PseudoLinearNormalForm(K:Field): Exports == Implementation where i := i + 1 else -- apply lemma 6 - for j in i..2 by -1 repeat + for j: local in i..2 by -1 repeat for k in (i+1)..N repeat E := addMatrix(N, k, j-1, M(k,j)) M := changeBase(M, E, sig, der) diff --git a/src/algebra/radeigen.spad.pamphlet b/src/algebra/radeigen.spad.pamphlet index e9232fc1..2a7f9ff3 100644 --- a/src/algebra/radeigen.spad.pamphlet +++ b/src/algebra/radeigen.spad.pamphlet @@ -157,7 +157,7 @@ RadicalEigenPackage() : C == T n := nrows v RMR:=RectangularMatrix(n:PI,1,RE) orth:List(MRE):=[(normalise v)] - for v in lvect.rest repeat + for v: local in lvect.rest repeat pol:=((v:RMR)-(+/[(innerprod(w,v)*w):RMR for w in orth])):MRE orth:=cons(normalise pol,orth) orth diff --git a/src/algebra/radix.spad.pamphlet b/src/algebra/radix.spad.pamphlet index 79c4aa17..df8308ad 100644 --- a/src/algebra/radix.spad.pamphlet +++ b/src/algebra/radix.spad.pamphlet @@ -231,7 +231,7 @@ RadixExpansion(bb): Exports == Implementation where n := i -- 2. Find p = first i such that rits.i = rits.(i+n) ritsi := rits - ritsn := rits; for i in 1..n repeat ritsn := rest ritsn + ritsn := rits; for i: local in 1..n repeat ritsn := rest ritsn i := 0 while first(ritsi) ~= first(ritsn) repeat ritsi := rest ritsi @@ -239,11 +239,11 @@ RadixExpansion(bb): Exports == Implementation where i := i + 1 p := i -- 3. Find c = first i such that rits.p = rits.(p+i) - ritsn := rits; for i in 1..n repeat ritsn := rest ritsn + ritsn := rits; for i: local in 1..n repeat ritsn := rest ritsn rn := first ritsn cfound:= false c : I := 0 - for i in 1..p while not cfound repeat + for i: local in 1..p while not cfound repeat ritsn := rest ritsn if rn = first(ritsn) then c := i @@ -252,10 +252,10 @@ RadixExpansion(bb): Exports == Implementation where -- 4. Now produce the lists of ragits. ritspfx: List I := nil() ritscyc: List I := nil() - for i in 1..p repeat + for i: local in 1..p repeat ritspfx := concat(first(rits).quotient, ritspfx) rits := rest rits - for i in 1..c repeat + for i: local in 1..c repeat ritscyc := concat(first(rits).quotient, ritscyc) rits := rest rits [reverse! ritspfx, reverse! ritscyc] diff --git a/src/algebra/regset.spad.pamphlet b/src/algebra/regset.spad.pamphlet index 262a9789..46a30486 100644 --- a/src/algebra/regset.spad.pamphlet +++ b/src/algebra/regset.spad.pamphlet @@ -577,7 +577,7 @@ QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where removeSuperfluousCases (cases:List LpWT) == #cases < 2 => cases toSee := sort(supDimElseRittWu?(#1.tower,#2.tower),cases) - lpwt1,lpwt2 : LpWT + lpwt1 : LpWT toSave,headmaxcases,maxcases,copymaxcases : List LpWT while not empty? toSee repeat lpwt1 := first toSee @@ -670,14 +670,14 @@ QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where (empty? leq) or (empty? lineq) => ([leq, ts, lineq]$Branch)::UBF if b4 then - for q in lineq repeat + for q: local in lineq repeat zero? initiallyReduce(q,ts) => return("failed"::Union(Branch,"failed")) if b5 then newleq: LP := [] for p in leq repeat - for q in lineq repeat + for q: local in lineq repeat if mvar(p) = mvar(q) then g := gcd(p,q) @@ -1050,12 +1050,12 @@ RegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation where p3: P := LazardQuotient2(p2, leadingCoefficient(p2,v), s, delta) zero?(degree(p3,v)) => toReturn := cons([p3,lpwt.tower]$PWT, toReturn) - for lpwt in toSee repeat + for lpwt: free in toSee repeat toReturn := cons([p3,lpwt.tower]$PWT, toReturn) (p1, p2) := (p3, next_subResultant2(p1, p2, p3, s)) s := leadingCoefficient(p1,v) llpwt := cons([[p1,p2,s],lpwt.tower]$LpWT, llpwt) - for lpwt in toSee repeat + for lpwt:local in toSee repeat llpwt := cons([[p1,p2,s],lpwt.tower]$LpWT, llpwt) toReturn @@ -1295,7 +1295,7 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where s: String := concat ["[", string((#toSee)::Z), " ", convert(lpwt)@String] m: N := #(lpwt.val) toSee := rest toSee - for lpwt in toSee repeat + for lpwt: local in toSee repeat m := m + #(lpwt.val) s := concat [s, ",", convert(lpwt)@String] s := concat [s, " -> |", string(m::Z), "|; {", string(n::Z),"}]"] diff --git a/src/algebra/rep2.spad.pamphlet b/src/algebra/rep2.spad.pamphlet index ed4e7b0b..ea41c131 100644 --- a/src/algebra/rep2.spad.pamphlet +++ b/src/algebra/rep2.spad.pamphlet @@ -770,7 +770,7 @@ RepresentationPackage2(R): public == private where nred : I := n rem ((q**dim -1) quo (q-1)) pos : I := nred i : I := 0 - for i in 0..dim-1 while nred >= 0 repeat + for i: free in 0..dim-1 while nred >= 0 repeat pos := nred nred := nred - (q**i) i := if i = 0 then 0 else i-1 @@ -780,7 +780,7 @@ RepresentationPackage2(R): public == private where for j in 1..(maxIndex iR) repeat coefficients.(dim-((#iR)::I) +j) := index((iR.j+(q::I))::PI)$R result : V R := new(nn,0) - for i in 1..maxIndex coefficients repeat + for i: local in 1..maxIndex coefficients repeat newAdd : V R := coefficients.i * basis.i for j in 1..nn repeat result.j := result.j + newAdd.j diff --git a/src/algebra/sgcf.spad.pamphlet b/src/algebra/sgcf.spad.pamphlet index c6eb2ffd..c16691d8 100644 --- a/src/algebra/sgcf.spad.pamphlet +++ b/src/algebra/sgcf.spad.pamphlet @@ -213,7 +213,7 @@ SymmetricGroupCombinatoricFunctions(): public == private where s : I := 0 sOld: I y : I - for y in 0..n repeat + for y: free in 0..n repeat sOld := s s := s + numberOfImproperPartitions(n-y,m-t-1) if s > k then leave @@ -242,7 +242,7 @@ SymmetricGroupCombinatoricFunctions(): public == private where cm := cm - 1 sOld : I y : I - for y in n..1 by -1 repeat --determination of the next son + for y: free in n..1 by -1 repeat --determination of the next son sOld := s -- remember old s -- this functions counts the number of elements in a subtree s := s + numberOfImproperPartitionsInternal(n-y,m,cm) @@ -271,7 +271,7 @@ SymmetricGroupCombinatoricFunctions(): public == private where s : I := m for t in 0..(m-1) repeat y : Integer - for y in (s-1)..(n+1) repeat + for y: free in (s-1)..(n+1) repeat if binomial$ICF (y,s) > mm then leave l := append (l,list(y-1)$(L I)) mm := mm - binomial$ICF (y-1,s) @@ -405,7 +405,7 @@ SymmetricGroupCombinatoricFunctions(): public == private where -- vrest(k) := alpha(k) coleman := new(nrow,ncol,0) j : I := 0 - for i in (j+1)::NNI..nrow-1 repeat + for i: local in (j+1)::NNI..nrow-1 repeat succ := nextPartition(vrest,vnull,beta(i)) coleman := setRow!(coleman, i, succ) vrest := vrest - succ diff --git a/src/algebra/smith.spad.pamphlet b/src/algebra/smith.spad.pamphlet index 34b8f55b..4e824033 100644 --- a/src/algebra/smith.spad.pamphlet +++ b/src/algebra/smith.spad.pamphlet @@ -185,7 +185,7 @@ SmithNormalForm(R,Row,Col,M) : Exports == Implementation where t11:=t1(1,1) for i in 1..m1 repeat u(i,1) := (mm(i,1) exquo t11) :: R - for j in 2..m1 repeat + for j: local in 2..m1 repeat j0:=j tjj : R while zero?(tjj:=t1(j,j0)) repeat j0:=j0+1 diff --git a/src/algebra/sregset.spad.pamphlet b/src/algebra/sregset.spad.pamphlet index c301db79..a476fd73 100644 --- a/src/algebra/sregset.spad.pamphlet +++ b/src/algebra/sregset.spad.pamphlet @@ -379,14 +379,14 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where (empty? leq) or (empty? lineq) => ([leq, ts, lineq]$Branch)::UBF if b4 then - for q in lineq repeat + for q: local in lineq repeat zero? initiallyReduce(q,ts) => return("failed"::Union(Branch,"failed")) if b5 then newleq: LP := [] for p in leq repeat - for q in lineq repeat + for q: local in lineq repeat if mvar(p) = mvar(q) then g := gcd(p,q) @@ -637,12 +637,12 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation p3: P := LazardQuotient2(p2, leadingCoefficient(p2,v), s, delta) zero?(degree(p3,v)) => toReturn := cons([p3,lpwt.tower]$PWT, toReturn) - for lpwt in toSee repeat + for lpwt: local in toSee repeat toReturn := cons([p3,lpwt.tower]$PWT, toReturn) (p1, p2) := (p3, next_subResultant2(p1, p2, p3, s)) s := leadingCoefficient(p1,v) llpwt := cons([[p1,p2,s],lpwt.tower]$LpWT, llpwt) - for lpwt in toSee repeat + for lpwt: local in toSee repeat llpwt := cons([[p1,p2,s],lpwt.tower]$LpWT, llpwt) toReturn @@ -716,7 +716,7 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation (ground? g) or (mvar(g) < v) => lts := augment(ts_v,ts)$TS lts := augment(members(ts_v_+),lts)$TS - for ts in lts repeat + for ts: local in lts repeat lbwt := cons([true, ts]$BWT,lbwt) g := mainPrimitivePart g lts_g := augment(g,ts)$TS @@ -801,7 +801,7 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation (ground? g) or (mvar(g) < v) => lts := augment(ts_v,ts)$TS lts := augment(members(ts_v_+),lts)$TS - for ts in lts repeat + for ts: local in lts repeat lbwt := cons([true, ts]$BWT,lbwt) g := mainPrimitivePart g lts_g := augment(g,ts)$TS @@ -1091,7 +1091,7 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation s: String := concat ["[", string((#toSee)::Z), " ", convert(lpwt)@String] m: N := #(lpwt.val) toSee := rest toSee - for lpwt in toSee repeat + for lpwt: local in toSee repeat m := m + #(lpwt.val) s := concat [s, ",", convert(lpwt)@String] s := concat [s, " -> |", string(m::Z), "|; {", string(n::Z),"}]"] diff --git a/src/algebra/syssolp.spad.pamphlet b/src/algebra/syssolp.spad.pamphlet index 3fb9ba0a..adeca5b4 100644 --- a/src/algebra/syssolp.spad.pamphlet +++ b/src/algebra/syssolp.spad.pamphlet @@ -119,7 +119,7 @@ SystemSolvePackage(R): Cat == Cap where np:=numer makeP2F p lx:=variables np x : SE - for x in lv repeat if member?(x,lx) then leave x + for x: free in lv repeat if member?(x,lx) then leave x up:=univariate(np,x) (degree up)=1 => equation(x::P(R)::F,-coefficient(up,0)/leadingCoefficient up) diff --git a/src/algebra/tex.spad.pamphlet b/src/algebra/tex.spad.pamphlet index 180c4c26..dcc181ea 100644 --- a/src/algebra/tex.spad.pamphlet +++ b/src/algebra/tex.spad.pamphlet @@ -245,7 +245,6 @@ TexFormat(): public == private where f display(f : $, len : I) == - s,t : S for s in f.prolog repeat sayTeX$Lisp s for s in f.TeX repeat for t in splitLong(s, len) repeat sayTeX$Lisp t @@ -263,7 +262,6 @@ TexFormat(): public == private where setEpilogue!(f : $, l : L S) == f.epilog := l coerce(f : $): E == - s,t : S l : L S := nil for s in f.prolog repeat l := concat(s,l) for s in f.TeX repeat @@ -329,7 +327,6 @@ TexFormat(): public == private where l : List S := nil s : S := "" ls : I := 0 - ss : S lss : I for ss in split(str,char " ") repeat -- have the newline macro end a line (even if it means the line diff --git a/src/algebra/updecomp.spad.pamphlet b/src/algebra/updecomp.spad.pamphlet index fba1182a..cf0c85b3 100644 --- a/src/algebra/updecomp.spad.pamphlet +++ b/src/algebra/updecomp.spad.pamphlet @@ -86,10 +86,8 @@ UnivariatePolynomialDecompositionPackage(R,UP): Exports == Implementation where s := subtractIfCan(dq,1)::N lcp := leadingCoefficient p q: UP := monomial(lcq,dq) - k: N for k in 1..s repeat c: R := 0 - i: N for i in 0..subtractIfCan(k,1)::N repeat c := c+(k::R-(n::R+1)*(i::R))* coefficient(q,subtractIfCan(dq,i)::N)* diff --git a/src/algebra/zerodim.spad.pamphlet b/src/algebra/zerodim.spad.pamphlet index 1d9fae67..21ee0bcc 100644 --- a/src/algebra/zerodim.spad.pamphlet +++ b/src/algebra/zerodim.spad.pamphlet @@ -314,7 +314,7 @@ LexTriangularPackage(R,ls): Exports == Implementation where newlp := lp while (not empty? newlp) and (mvar(first newlp) = v) repeat newlp := rest newlp - for us in lus repeat + for us: local in lus repeat toSee := cons([newlp, us]$LpWTS, toSee) algebraicSort(toSave)$quasicomppackTS @@ -357,7 +357,7 @@ LexTriangularPackage(R,ls): Exports == Implementation where newlp := lp while (not empty? newlp) and (mvar(first newlp) = v) repeat newlp := rest newlp - for us in lus repeat + for us: local in lus repeat toSee := cons([newlp, us]$LpWST, toSee) algebraicSort(toSave)$quasicomppackST @@ -563,7 +563,7 @@ InternalRationalUnivariateRepresentationPackage(R,E,V,P,TS): Exports == Implemen wip := [lp,ts] toSee := cons(wip,toSee) lts := makeLinearAndMonic(p,xi,ts,univ?,false,false) - for ts in lts repeat + for ts: local in lts repeat wip := [lp,ts] toSee := cons(wip,toSee) toSave @@ -687,7 +687,7 @@ RationalUnivariateRepresentationPackage(R,ls): Exports == Implementation where newlq := [remainder(q,newts).polnum for q in lq] toSee := cons([newlq,newts]$LQWT,toSee) toReturn: List RUR := [] - for ts in toSave repeat + for ts: local in toSave repeat lus := rur(ts,univ?)$rurpack check? and (not checkRur(ts,lus)$rurpack) => output("RUR for: ")$OutputPackage 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] |