diff --git a/books/bookvol10.3.pamphlet b/books/bookvol10.3.pamphlet index f0c0ed8..a72ba45 100644 --- a/books/bookvol10.3.pamphlet +++ b/books/bookvol10.3.pamphlet @@ -79,6 +79,23 @@ o )show AffinePlane {\bf Exports:}\\ \begin{tabular}{lllll} +\cross{AFFPL}{?=?} & +\cross{AFFPL}{?\~{}=?} & +\cross{AFFPL}{?.?} & +\cross{AFFPL}{affinePoint} & +\cross{AFFPL}{coerce} \\ +\cross{AFFPL}{conjugate} & +\cross{AFFPL}{definingField} & +\cross{AFFPL}{degree} & +\cross{AFFPL}{hash} & +\cross{AFFPL}{latex} \\ +\cross{AFFPL}{list} & +\cross{AFFPL}{orbit} & +\cross{AFFPL}{origin} & +\cross{AFFPL}{pointValue} & +\cross{AFFPL}{rational?} \\ +\cross{AFFPL}{setelt} & +\cross{AFFPL}{removeConjugate} &&& \end{tabular} \begin{chunk}{domain AFFPL AffinePlane} @@ -303,7 +320,8 @@ AffineSpace(dim,K):Exports == Implementation where Rep:= List(K) - origin== new(dim,0$K)$List(K) + origin == + new(dim,0$K)$List(K) coerce(pt:%):OutputForm == dd:OutputForm:= ":" :: OutputForm @@ -314,39 +332,43 @@ AffineSpace(dim,K):Exports == Implementation where ee:OutputForm:= degree(pt) :: OutputForm oo**ee - definingField(pt)== + definingField(pt) == K has PseudoAlgebraicClosureOfPerfectFieldCategory => _ maxTower(pt@Rep) 1$K - degree(pt)== + degree(pt) == K has PseudoAlgebraicClosureOfPerfectFieldCategory => _ extDegree definingField pt 1 - coerce(pt:%):List(K) == pt@Rep + coerce(pt:%):List(K) == + pt@Rep - affinePoint(pt:LIST(K))== - pt :: % + affinePoint(pt:LIST(K)) == + pt :: % - list(ptt)== + list(ptt) == ptt@Rep - pointValue(ptt)== + pointValue(ptt) == ptt@Rep - conjugate(p,e)== + conjugate(p,e) == lp:Rep:=p pc:List(K):=[c**e for c in lp] affinePoint(pc) - rational?(p,n)== p=conjugate(p,n) + rational?(p,n) == + p = conjugate(p,n) - rational?(p)==rational?(p,characteristic()$K) + rational?(p) == + rational?(p,characteristic()$K) - removeConjugate(l)==removeConjugate(l,characteristic()$K) + removeConjugate(l) == + removeConjugate(l,characteristic()$K) - removeConjugate(l:LIST(%),n:NNI):LIST(%)== + removeConjugate(l:LIST(%),n:NNI):LIST(%) == if K has FiniteFieldCategory then allconj:LIST(%):=empty() conjrem:LIST(%):=empty() @@ -358,9 +380,11 @@ AffineSpace(dim,K):Exports == Implementation where else error "The field is not finite" - conjugate(p)==conjugate(p,characteristic()$K) + conjugate(p) == + conjugate(p,characteristic()$K) - orbit(p)==orbit(p,characteristic()$K) + orbit(p) == + orbit(p,characteristic()$K) orbit(p,e)== if K has FiniteFieldCategory then @@ -378,7 +402,7 @@ AffineSpace(dim,K):Exports == Implementation where aa:% = bb:% == aa =$Rep bb - coerce(pt:LIST(K))== + coerce(pt:LIST(K)) == ^(dim=#pt) => error "Le point n'a pas la bonne dimension" ptt:%:= pt ptt @@ -595,7 +619,7 @@ o )show AlgebraGivenByStructuralConstants ++ have to be given as a list of symbols. AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_ - ls : List Symbol, gamma: Vector Matrix R ): public == private where + ls : List Symbol, gamma: Vector Matrix R ): Exports == Implementation where V ==> Vector M ==> Matrix @@ -604,8 +628,7 @@ AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_ REC ==> Record(particular: Union(V R,"failed"),basis: List V R) LSMP ==> LinearSystemMatrixPackage(R,V R,V R, M R) - --public ==> FramedNonAssociativeAlgebra(R) with - public ==> Join(FramedNonAssociativeAlgebra(R), _ + Exports ==> Join(FramedNonAssociativeAlgebra(R), _ LeftModule(SquareMatrix(n,R)) ) with coerce : Vector R -> % @@ -614,7 +637,7 @@ AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_ ++ Note: the vector is assumed to have length equal to the ++ dimension of the algebra. - private ==> DirectProduct(n,R) add + Implementation ==> DirectProduct(n,R) add Rep := DirectProduct(n,R) @@ -622,15 +645,22 @@ AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_ dp : DirectProduct(n,R) v : V R + recip(x) == + recip(x)$FiniteRankNonAssociativeAlgebra_&(%,R) + + (m:SquareMatrix(n,R))*(x:%) == + apply((m :: Matrix R),x) - recip(x) == recip(x)$FiniteRankNonAssociativeAlgebra_&(%,R) + coerce v == + directProduct(v) :: % - (m:SquareMatrix(n,R))*(x:%) == apply((m :: Matrix R),x) - coerce v == directProduct(v) :: % + structuralConstants() == + gamma - structuralConstants() == gamma + coordinates(x) == + vector(entries(x :: Rep)$Rep)$Vector(R) - coordinates(x) == vector(entries(x :: Rep)$Rep)$Vector(R) + er1:="coordinates: first argument is not in linear span of second argument" coordinates(x,b) == --not (maxIndex b = n) => @@ -642,17 +672,20 @@ AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_ res : REC := solve(transitionMatrix,coordinates(x))$LSMP if (not every?(zero?$R,first res.basis)) then error("coordinates: warning your 'basis' is linearly dependent") - (res.particular case "failed") => - error("coordinates: first argument is not in linear span of second argument") + (res.particular case "failed") => error(er1) (res.particular) :: (Vector R) - basis() == [unitVector(i::PositiveInteger)::% for i in 1..n] + basis() == + [unitVector(i::PositiveInteger)::% for i in 1..n] - someBasis() == basis()$% + someBasis() == + basis()$% - rank() == n + rank() == + n - elt(x,i) == elt(x:Rep,i)$Rep + elt(x,i) == + elt(x:Rep,i)$Rep coerce(x:%):OutputForm == zero?(x::Rep)$Rep => (0$R) :: OutputForm @@ -660,7 +693,6 @@ AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_ for i in 1..n repeat coef : R := elt(x::Rep,i) not zero?(coef)$R => --- one?(coef)$R => ((coef) = 1)$R => -- sy : OutputForm := elt(ls,i)$(List Symbol) :: OutputForm le := cons(elt(ls,i)$(List Symbol) :: OutputForm, le) @@ -678,7 +710,7 @@ AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_ v.k := h directProduct v - + er2:="algebra satisfies 2*associator(a,b,b)=0 = 2*associator(a,a,b)=0" alternative?() == for i in 1..n repeat @@ -735,29 +767,9 @@ AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_ messagePrint("algebra is not right alternative")$OutputForm return false - messagePrint("algebra satisfies 2*associator(a,b,b) = 0 = 2*associator(a,a,b) = 0")$OutputForm + messagePrint(er2)$OutputForm true - -- should be in the category, but is not exported --- conditionsForIdempotents b == --- n := rank() --- --gamma : Vector Matrix R := structuralConstants b --- listOfNumbers : List String := [STRINGIMAGE(q)$Lisp for q in 1..n] --- symbolsForCoef : Vector Symbol := --- [concat("%", concat("x", i))::Symbol for i in listOfNumbers] --- conditions : List Polynomial R := [] - -- for k in 1..n repeat - -- xk := symbolsForCoef.k - -- p : Polynomial R := monomial( - 1$Polynomial(R), [xk], [1] ) - -- for i in 1..n repeat - -- for j in 1..n repeat - -- xi := symbolsForCoef.i - -- xj := symbolsForCoef.j - -- p := p + monomial(_ - -- elt((gamma.k),i,j) :: Polynomial(R), [xi,xj], [1,1]) - -- conditions := cons(p,conditions) - -- conditions - associative?() == for i in 1..n repeat for j in 1..n repeat @@ -773,7 +785,6 @@ AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_ messagePrint("algebra is associative")$OutputForm true - antiAssociative?() == for i in 1..n repeat for j in 1..n repeat @@ -803,7 +814,8 @@ AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_ for i in 1..n repeat for j in i..n repeat for k in 1..n repeat - not zero? (i=j => elt(gamma.k,i,i); elt(gamma.k,i,j)+elt(gamma.k,j,i) ) => + not zero? (i=j => elt(gamma.k,i,i); _ + elt(gamma.k,i,j)+elt(gamma.k,j,i) ) => messagePrint("algebra is not anti-commutative")$OutputForm return false messagePrint("algebra is anti-commutative")$OutputForm @@ -817,8 +829,9 @@ AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_ for r in 1..n repeat res := 0$R for l in 1..n repeat - res := res + (elt(gamma.l,i,j)+elt(gamma.l,j,i))*elt(gamma.r,l,k)-_ - (elt(gamma.l,j,k)*elt(gamma.r,i,l) + elt(gamma.l,i,k)*elt(gamma.r,j,l) ) + res := res+(elt(gamma.l,i,j)+elt(gamma.l,j,i))*elt(gamma.r,l,k)-_ + (elt(gamma.l,j,k)*elt(gamma.r,i,l) + _ + elt(gamma.l,i,k)*elt(gamma.r,j,l) ) not (zero? res) => messagePrint("algebra is not left alternative")$OutputForm return false @@ -834,8 +847,9 @@ AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_ for r in 1..n repeat res := 0$R for l in 1..n repeat - res := res - (elt(gamma.l,j,k)+elt(gamma.l,k,j))*elt(gamma.r,i,l)+_ - (elt(gamma.l,i,j)*elt(gamma.r,l,k) + elt(gamma.l,i,k)*elt(gamma.r,l,j) ) + res := res-(elt(gamma.l,j,k)+elt(gamma.l,k,j))*elt(gamma.r,i,l)+_ + (elt(gamma.l,i,j)*elt(gamma.r,l,k) + _ + elt(gamma.l,i,k)*elt(gamma.r,l,j) ) not (zero? res) => messagePrint("algebra is not right alternative")$OutputForm return false @@ -869,18 +883,24 @@ AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_ res := 0$R for l in 1..n repeat res := res_ - + (elt(gamma.l,i,j)-elt(gamma.l,j,i))*(elt(gamma.r,l,k)-elt(gamma.r,k,l)) _ - + (elt(gamma.l,j,k)-elt(gamma.l,k,j))*(elt(gamma.r,l,i)-elt(gamma.r,i,l)) _ - + (elt(gamma.l,k,i)-elt(gamma.l,i,k))*(elt(gamma.r,l,j)-elt(gamma.r,j,l)) + + (elt(gamma.l,i,j)-elt(gamma.l,j,i))*_ + (elt(gamma.r,l,k)-elt(gamma.r,k,l)) _ + + (elt(gamma.l,j,k)-elt(gamma.l,k,j))*_ + (elt(gamma.r,l,i)-elt(gamma.r,i,l)) _ + + (elt(gamma.l,k,i)-elt(gamma.l,i,k))*_ + (elt(gamma.r,l,j)-elt(gamma.r,j,l)) not (zero? res) => messagePrint("algebra is not Lie admissible")$OutputForm return false messagePrint("algebra is Lie admissible")$OutputForm true + er3:="this algebra is not Jordan admissible, _ + as 2 is not invertible in the ground ring" + jordanAdmissible?() == recip(2 * 1$R) case "failed" => - messagePrint("this algebra is not Jordan admissible, as 2 is not invertible in the ground ring")$OutputForm + messagePrint(er3)$OutputForm false for i in 1..n repeat for j in 1..n repeat @@ -915,9 +935,12 @@ AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_ messagePrint("algebra is Jordan admissible")$OutputForm true + er4:="this is not a Jordan algebra, _ + as 2 is not invertible in the ground ring" + jordanAlgebra?() == recip(2 * 1$R) case "failed" => - messagePrint("this is not a Jordan algebra, as 2 is not invertible in the ground ring")$OutputForm + messagePrint(er4)$OutputForm false not commutative?() => messagePrint("this is not a Jordan algebra")$OutputForm @@ -1279,6 +1302,13 @@ o )show AlgebraicFunctionField \cross{ALGFF}{?rem?} \\ \end{tabular} +{\bf Locals:}\\ +\begin{tabular}{lll} +\cross{ALGFF}{getInfBasis} & +\cross{ALGFF}{startUp} & +\cross{ALGFF}{vect} +\end{tabular} + \begin{chunk}{domain ALGFF AlgebraicFunctionField} )abbrev domain ALGFF AlgebraicFunctionField ++ Author: Manuel Bronstein @@ -1287,7 +1317,7 @@ o )show AlgebraicFunctionField ++ Description: ++ Function field defined by f(x, y) = 0. -AlgebraicFunctionField(F, UP, UPUP, modulus): Exports == Impl where +AlgebraicFunctionField(F, UP, UPUP, modulus): Exports == Implementation where F : Field UP : UnivariatePolynomialCategory F UPUP : UnivariatePolynomialCategory Fraction UP @@ -1302,10 +1332,12 @@ AlgebraicFunctionField(F, UP, UPUP, modulus): Exports == Impl where INIT ==> if (deref brandNew?) then startUp false Exports ==> FunctionFieldCategory(F, UP, UPUP) with - knownInfBasis: N -> Void - ++ knownInfBasis(n) is not documented - Impl ==> SAE add + knownInfBasis : N -> Void + ++ knownInfBasis(n) is not documented + + Implementation ==> SAE add + import ChangeOfVariable(F, UP, UPUP) import InnerCommonDenominator(UP, RF, Vector UP, Vector RF) import MatrixCommonDenominator(UP, RF) @@ -1325,16 +1357,35 @@ AlgebraicFunctionField(F, UP, UPUP, modulus): Exports == Impl where infbasis:Matrix(RF) := copy ibasis invinfbasis:Matrix(RF):= copy ibasis - branchPointAtInfinity?() == (INIT; infBr?()) - discriminant() == (INIT; discPoly()) - integralBasis() == (INIT; vect ibasis) - integralBasisAtInfinity() == (INIT; vect infbasis) - integralMatrix() == (INIT; ibasis) - inverseIntegralMatrix() == (INIT; invibasis) - integralMatrixAtInfinity() == (INIT; infbasis) - branchPoint?(a:F) == zero?((retract(discriminant())@UP) a) - definingPolynomial() == modulus - inverseIntegralMatrixAtInfinity() == (INIT; invinfbasis) + branchPointAtInfinity?() == + (INIT; infBr?()) + + discriminant() == + (INIT; discPoly()) + + integralBasis() == + (INIT; vect ibasis) + + integralBasisAtInfinity() == + (INIT; vect infbasis) + + integralMatrix() == + (INIT; ibasis) + + inverseIntegralMatrix() == + (INIT; invibasis) + + integralMatrixAtInfinity() == + (INIT; infbasis) + + branchPoint?(a:F) == + zero?((retract(discriminant())@UP) a) + + definingPolynomial() == + modulus + + inverseIntegralMatrixAtInfinity() == + (INIT; invinfbasis) vect m == [represents row(m, i) for i in minRowIndex m .. maxRowIndex m] @@ -1682,35 +1733,51 @@ AlgebraicNumber(): Exports == Implementation where LinearlyExplicitRingOver Fraction Z, CharacteristicZero, ConvertibleTo Complex Float, DifferentialRing) with + coerce : P -> % ++ coerce(p) returns p viewed as an algebraic number. - numer : % -> P + + numer : % -> P ++ numer(f) returns the numerator of f viewed as a ++ polynomial in the kernels over Z. - denom : % -> P + + denom : % -> P ++ denom(f) returns the denominator of f viewed as a ++ polynomial in the kernels over Z. + reduce : % -> % ++ reduce(f) simplifies all the unreduced algebraic numbers ++ present in f by applying their defining relations. + norm : (SUP(%),Kernel %) -> SUP(%) ++ norm(p,k) computes the norm of the polynomial p ++ with respect to the extension generated by kernel k + norm : (SUP(%),List Kernel %) -> SUP(%) ++ norm(p,l) computes the norm of the polynomial p ++ with respect to the extension generated by kernels l + norm : (%,Kernel %) -> % ++ norm(f,k) computes the norm of the algebraic number f ++ with respect to the extension generated by kernel k + norm : (%,List Kernel %) -> % ++ norm(f,l) computes the norm of the algebraic number f ++ with respect to the extension generated by kernels l + Implementation ==> InnerAlgebraicNumber add + Rep:=InnerAlgebraicNumber a,b:% - zero? a == trueEqual(a::Rep,0::Rep) - one? a == trueEqual(a::Rep,1::Rep) - a=b == trueEqual((a-b)::Rep,0::Rep) + + zero? a == + trueEqual(a::Rep,0::Rep) + + one? a == + trueEqual(a::Rep,1::Rep) + + a=b == + trueEqual((a-b)::Rep,0::Rep) \end{chunk} \begin{chunk}{AN.dotabb} @@ -1778,7 +1845,9 @@ o )show AnonymousFunction ++ This domain implements anonymous functions AnonymousFunction():SetCategory == add - coerce(x:%):OutputForm == x pretend OutputForm + + coerce(x:%):OutputForm == + x pretend OutputForm \end{chunk} \begin{chunk}{ANON.dotabb} @@ -1860,12 +1929,12 @@ o )show AntiSymm \begin{tabular}{lllll} \cross{ANTISYM}{1} & \cross{ANTISYM}{0} & +\cross{ANTISYM}{characteristic} & \cross{ANTISYM}{coefficient} & -\cross{ANTISYM}{coerce} & \cross{ANTISYM}{coerce} \\ -\cross{ANTISYM}{coerce} & \cross{ANTISYM}{degree} & \cross{ANTISYM}{exp} & +\cross{ANTISYM}{generator} & \cross{ANTISYM}{hash} & \cross{ANTISYM}{homogeneous?} \\ \cross{ANTISYM}{latex} & @@ -1876,21 +1945,28 @@ o )show AntiSymm \cross{ANTISYM}{recip} & \cross{ANTISYM}{reductum} & \cross{ANTISYM}{retract} & -\cross{ANTISYM}{retractable?} & -\cross{ANTISYM}{sample} \\ -\cross{ANTISYM}{zero?} & -\cross{ANTISYM}{characteristic} & -\cross{ANTISYM}{generator} & \cross{ANTISYM}{retractIfCan} & -\cross{ANTISYM}{subtractIfCan} \\ +\cross{ANTISYM}{retractable?} \\ +\cross{ANTISYM}{sample} & +\cross{ANTISYM}{subtractIfCan} & +\cross{ANTISYM}{zero?} & \cross{ANTISYM}{?*?} & -\cross{ANTISYM}{?**?} & +\cross{ANTISYM}{?**?} \\ \cross{ANTISYM}{?+?} & \cross{ANTISYM}{?-?} & -\cross{ANTISYM}{-?} \\ +\cross{ANTISYM}{-?} & \cross{ANTISYM}{?=?} & -\cross{ANTISYM}{?\^{}?} & -\cross{ANTISYM}{?\~{}=?} && +\cross{ANTISYM}{?\^{}?} \\ +\cross{ANTISYM}{?\~{}=?} &&&& +\end{tabular} + +{\bf Locals:}\\ +\begin{tabular}{lllll} +\cross{ANTISYM}{displayList} & +\cross{ANTISYM}{getsgn} & +\cross{ANTISYM}{makeTerm} & +\cross{ANTISYM}{Nalpha} & +\cross{ANTISYM}{zo} \end{tabular} \begin{chunk}{domain ANTISYM AntiSymm} @@ -1901,7 +1977,8 @@ o )show AntiSymm ++ Description: ++ The domain of antisymmetric polynomials. -AntiSymm(R:Ring, lVar:List Symbol): Export == Implement where +AntiSymm(R:Ring, lVar:List Symbol): Exports == Implementation where + LALG ==> LeftAlgebra FMR ==> FM(R,EAB) FM ==> FreeModule @@ -1914,11 +1991,10 @@ AntiSymm(R:Ring, lVar:List Symbol): Export == Implement where coef ==> c Term ==> Record(k:EAB,c:R) - Export == Join(LALG(R), RetractableTo(R)) with + Exports == Join(LALG(R), RetractableTo(R)) with leadingCoefficient : % -> R ++ leadingCoefficient(p) returns the leading ++ coefficient of antisymmetric polynomial p. --- leadingSupport : % -> EAB leadingBasisTerm : % -> % ++ leadingBasisTerm(p) returns the leading ++ basis term of antisymmetric polynomial p. @@ -1948,13 +2024,13 @@ AntiSymm(R:Ring, lVar:List Symbol): Export == Implement where ++ map(f,p) changes each coefficient of p by the ++ application of f. - -- 1 corresponds to the empty monomial Nul = [0,...,0] -- from EAB. In terms of the exterior algebra on X, -- it corresponds to the identity element which lives -- in homogeneous degree 0. - Implement == FMR add + Implementation == FMR add + Rep := L Term x,y : EAB a,b : % @@ -1963,7 +2039,8 @@ AntiSymm(R:Ring, lVar:List Symbol): Export == Implement where dim := #lVar - 1 == [[ Nul(dim)$EAB, 1$R ]] + 1 == + [[ Nul(dim)$EAB, 1$R ]] coefficient(a,u) == not null u.rest => error "2nd argument must be a basis element" @@ -2046,7 +2123,8 @@ AntiSymm(R:Ring, lVar:List Symbol): Export == Implement where m = 0 => 0 [ [Nul(dim), m::R] ] - characteristic() == characteristic()$R + characteristic() == + characteristic()$R generator(j) == -- j < 1 or j > dim => error "your subscript is out of range" @@ -2055,7 +2133,8 @@ AntiSymm(R:Ring, lVar:List Symbol): Export == Implement where dum.j:=1 [[dum::EAB, 1::R]] - exp(li:(L I)) == [[li::EAB, 1]] + exp(li:(L I)) == + [[li::EAB, 1]] leadingBasisTerm a == [[a.first.k, 1]] @@ -2063,19 +2142,13 @@ AntiSymm(R:Ring, lVar:List Symbol): Export == Implement where displayList:EAB -> O displayList(x):O == le: L I := exponents(x)$EAB --- reduce(_*,[(lVar.i)::O for i in 1..dim | le.i = 1])$L(O) --- reduce(_*,[(lVar.i)::O for i in 1..dim | one?(le.i)])$L(O) reduce(_*,[(lVar.i)::O for i in 1..dim | ((le.i) = 1)])$L(O) makeTerm:(R,EAB) -> O makeTerm(r,x) == - -- we know that r ^= 0 + -- we know that r ^= 0 x = Nul(dim)$EAB => r::O --- one? r => displayList(x) (r = 1) => displayList(x) --- r = 1 => displayList(x) --- r = 0 => 0$I::O --- x = Nul(dim)$EAB => r::O r::O * displayList(x) coerce(a):O == @@ -2372,41 +2445,60 @@ o )show Any ++ to one of \spadtype{Any}. Any(): SetCategory with - any : (SExpression, None) -> % - ++ any(type,object) is a technical function for creating - ++ an object of \spadtype{Any}. Arugment \spad{type} is a - ++ \spadgloss{LISP} form for the type of \spad{object}. - domainOf : % -> OutputForm - ++ domainOf(a) returns a printable form of the type of the - ++ original object that was converted to \spadtype{Any}. - objectOf : % -> OutputForm - ++ objectOf(a) returns a printable form of the - ++ original object that was converted to \spadtype{Any}. - dom : % -> SExpression - ++ dom(a) returns a \spadgloss{LISP} form of the type of the - ++ original object that was converted to \spadtype{Any}. - obj : % -> None - ++ obj(a) essentially returns the original object that was - ++ converted to \spadtype{Any} except that the type is forced - ++ to be \spadtype{None}. - showTypeInOutput: Boolean -> String - ++ showTypeInOutput(bool) affects the way objects of - ++ \spadtype{Any} are displayed. If \spad{bool} is true - ++ then the type of the original object that was converted - ++ to \spadtype{Any} will be printed. If \spad{bool} is - ++ false, it will not be printed. + + any : (SExpression, None) -> % + ++ any(type,object) is a technical function for creating + ++ an object of \spadtype{Any}. Arugment \spad{type} is a + ++ \spadgloss{LISP} form for the type of \spad{object}. + + domainOf : % -> OutputForm + ++ domainOf(a) returns a printable form of the type of the + ++ original object that was converted to \spadtype{Any}. + + objectOf : % -> OutputForm + ++ objectOf(a) returns a printable form of the + ++ original object that was converted to \spadtype{Any}. + + dom : % -> SExpression + ++ dom(a) returns a \spadgloss{LISP} form of the type of the + ++ original object that was converted to \spadtype{Any}. + + obj : % -> None + ++ obj(a) essentially returns the original object that was + ++ converted to \spadtype{Any} except that the type is forced + ++ to be \spadtype{None}. + + showTypeInOutput: Boolean -> String + ++ showTypeInOutput(bool) affects the way objects of + ++ \spadtype{Any} are displayed. If \spad{bool} is true + ++ then the type of the original object that was converted + ++ to \spadtype{Any} will be printed. If \spad{bool} is + ++ false, it will not be printed. + ++ + ++X u:=[1,7.2,3/2,x**2,"wally"] + ++X showTypeInOutput(true) + ++X u == add + Rep := Record(dm: SExpression, ob: None) printTypeInOutputP:Reference(Boolean) := ref false - obj x == x.ob - dom x == x.dm - domainOf x == x.dm pretend OutputForm - x = y == (x.dm = y.dm) and EQ(x.ob, y.ob)$Lisp - x = y == - (x.dm = y.dm) and EQUAL(x.ob, y.ob)$Lisp + obj x == + x.ob + + dom x == + x.dm + + domainOf x == + x.dm pretend OutputForm + +-- x = y == +-- (x.dm = y.dm) and EQ(x.ob, y.ob)$Lisp + + x = y == + (x.dm = y.dm) and EQUAL(x.ob, y.ob)$Lisp objectOf(x : %) : OutputForm == spad2BootCoerce(x.ob, x.dm, @@ -58926,7 +59018,6 @@ HyperellipticFiniteDivisor(F, UP, UPUP, R): Exports == Implementation where coerce(d:%):O == r := bracket [d.center::O, d.polyPart::O] g := prefix(dvd, [d.principalPart::O]) --- z := one?(d.principalPart) z := (d.principalPart = 1) princ? d => (z => zer; g) z => r @@ -66898,7 +66989,7 @@ InputForm(): interpret x == v := interpret(x)$Lisp - mkObj(unwrap(objVal(v)$Lisp)$Lisp, objMode(v)$Lisp)$Lisp + mkObjFn(unwrap(objValFn(v)$Lisp)$Lisp, objModeFn(v)$Lisp)$Lisp convert(x:DoubleFloat):% == zero? x => 0 @@ -67762,6 +67853,16 @@ o )show Integer \cross{INT}{?rem?} &&& \end{tabular} +{\bf Locals:}\\ +\begin{tabular}{lll} +\cross{INT}{OMwrite} & +\cross{INT}{factorPolynomial} & +\cross{INT}{factorSquareFreePolynomial} \\ +\cross{INT}{solveLinearPolynomialEquation} & +\cross{INT}{squareFreePolynomial} & +\cross{INT}{writeOMInt} +\end{tabular} + \begin{chunk}{domain INT Integer} )abbrev domain INT Integer ++ Author: Mark Botch @@ -67780,9 +67881,13 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with infinite ++ nextItem never returns "failed". == add + ZP ==> SparseUnivariatePolynomial % + ZZP ==> SparseUnivariatePolynomial Integer + x,y: % + n: NonNegativeInteger writeOMInt(dev: OpenMathDevice, x: %): Void == @@ -67830,32 +67935,70 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with if wholeObj then OMputEndObject(dev) - zero? x == ZEROP(x)$Lisp --- one? x == ONEP(x)$Lisp - one? x == x = 1 - 0 == 0$Lisp - 1 == 1$Lisp - base() == 2$Lisp - copy x == x - inc x == x + 1 - dec x == x - 1 - hash x == SXHASH(x)$Lisp - negative? x == MINUSP(x)$Lisp - coerce(x):OutputForm == outputForm(x pretend Integer) - coerce(m:Integer):% == m pretend % - convert(x:%):Integer == x pretend Integer - length a == INTEGER_-LENGTH(a)$Lisp + zero? x == + ZEROP(x)$Lisp + + one? x == + x = 1 + + 0 == + 0$Lisp + + 1 == + 1$Lisp + + base() == + 2$Lisp + + copy x == + x + + inc x == + x + 1 + + dec x == + x - 1 + + hash x == + SXHASH(x)$Lisp + + negative? x == + MINUSP(x)$Lisp + + coerce(x):OutputForm == + outputForm(x pretend Integer) + + coerce(m:Integer):% == + m pretend % + + convert(x:%):Integer == + x pretend Integer + + length a == + INTEGER_-LENGTH(a)$Lisp + addmod(a, b, p) == - (c:=a + b) >= p => c - p - c + (c:=a + b) >= p => c - p + c + submod(a, b, p) == - (c:=a - b) < 0 => c + p - c - mulmod(a, b, p) == (a * b) rem p - convert(x:%):Float == coerce(x pretend Integer)$Float - convert(x:%):DoubleFloat == coerce(x pretend Integer)$DoubleFloat - convert(x:%):InputForm == convert(x pretend Integer)$InputForm - convert(x:%):String == string(x pretend Integer)$String + (c:=a - b) < 0 => c + p + c + + mulmod(a, b, p) == + (a * b) rem p + + convert(x:%):Float == + coerce(x pretend Integer)$Float + + convert(x:%):DoubleFloat == + coerce(x pretend Integer)$DoubleFloat + + convert(x:%):InputForm == + convert(x pretend Integer)$InputForm + + convert(x:%):String == + string(x pretend Integer)$String latex(x:%):String == s : String := string(x pretend Integer)$String @@ -67875,42 +68018,88 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with Record(mat:Matrix(Integer), vec:Vector(Integer)) == [m pretend Matrix(Integer), vec pretend Vector(Integer)] - abs(x) == ABS(x)$Lisp - random() == random()$Lisp - random(x) == RANDOM(x)$Lisp - x = y == EQL(x,y)$Lisp - x < y == (x "failed" zero?(x rem y) => x quo y "failed" --- recip(x) == if one? x or x=-1 then x else "failed" - recip(x) == if (x = 1) or x=-1 then x else "failed" - gcd(x,y) == GCD(x,y)$Lisp + + recip(x) == + if (x = 1) or x=-1 then x else "failed" + + gcd(x,y) == + GCD(x,y)$Lisp + UCA ==> Record(unit:%,canonical:%,associate:%) + unitNormal x == x < 0 => [-1,-x,-1]$UCA [1,x,1]$UCA - unitCanonical x == abs x + + unitCanonical x == + abs x + solveLinearPolynomialEquation(lp:List ZP,p:ZP):Union(List ZP,"failed") == - solveLinearPolynomialEquation(lp pretend List ZZP, + solveLinearPolynomialEquation(lp pretend List ZZP, p pretend ZZP)$IntegerSolveLinearPolynomialEquation pretend Union(List ZP,"failed") + squareFreePolynomial(p:ZP):Factored ZP == squareFree(p)$UnivariatePolynomialSquareFree(%,ZP) + factorPolynomial(p:ZP):Factored ZP == -- GaloisGroupFactorizer doesn't factor the content -- so we have to do this by hand @@ -67923,17 +68112,14 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with leadingCoefficient pp) ::%))$FactoredFunctions2(%,ZP) )$FactoredFunctionUtilities(ZP) + factorSquareFreePolynomial(p:ZP):Factored ZP == - factorSquareFree(p)$GaloisGroupFactorizer(ZP) + factorSquareFree(p)$GaloisGroupFactorizer(ZP) + gcdPolynomial(p:ZP, q:ZP):ZP == - zero? p => unitCanonical q - zero? q => unitCanonical p - gcd([p,q])$HeuGcd(ZP) --- myNextPrime: (%,NonNegativeInteger) -> % --- myNextPrime(x,n) == --- nextPrime(x)$IntegerPrimesPackage(%) --- TT:=InnerModularGcd(%,ZP,67108859 pretend %,myNextPrime) --- gcdPolynomial(p,q) == modularGcd(p,q)$TT + zero? p => unitCanonical q + zero? q => unitCanonical p + gcd([p,q])$HeuGcd(ZP) \end{chunk} \begin{chunk}{INT.dotabb} @@ -120981,9 +121167,6 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where VPoly:= Record(v:VarSet,ts:D) Rep:= Union(R,VPoly) - --local function - - --declarations fn: R -> R n: Integer @@ -121001,18 +121184,23 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where Lvar : List(VarSet) --define - 0 == 0$R::% - 1 == 1$R::% + 0 == + 0$R::% + + 1 == + 1$R::% + + zero? p == + p case R and zero?(p)$R + one? p == + p case R and ((p) = 1)$R - zero? p == p case R and zero?(p)$R --- one? p == p case R and one?(p)$R - one? p == p case R and ((p) = 1)$R - -- a local function + -- a local function red(p:%):% == - p case R => 0 - if ground?(reductum p.ts) then - leadingCoefficient(reductum p.ts) else [p.v,reductum p.ts]$VPoly + p case R => 0 + if ground?(reductum p.ts) then + leadingCoefficient(reductum p.ts) else [p.v,reductum p.ts]$VPoly numberOfMonomials(p): NonNegativeInteger == p case R => @@ -121020,7 +121208,8 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where 1 +/[numberOfMonomials q for q in coefficients(p.ts)] - coerce(mvar):% == [mvar,monomial(1,1)$D]$VPoly + coerce(mvar):% == + [mvar,monomial(1,1)$D]$VPoly monomial? p == p case R => true @@ -121029,6 +121218,7 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where monomial? leadingCoefficient(sup)$D -- local + moreThanOneVariable?: % -> Boolean moreThanOneVariable? p == @@ -121061,7 +121251,7 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where monomial(1,p.v,degree pt)*univariate(leadingCoefficient pt,mvar)+ univariate(red p,mvar) --- a local functions, used in next definition + -- a local functions, used in next definition unlikeUnivReconstruct(u:SparseUnivariatePolynomial(%),mvar:VarSet):% == zero? (d:=degree u) => coefficient(u,0) monomial(leadingCoefficient u,mvar,d)+ @@ -121080,10 +121270,6 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where p case R => true false --- const p == --- p case R => p --- error "the polynomial is not a constant" - monomial(p,mvar,k1) == zero? k1 or zero? p => p p case R or mvar>p.v => [mvar,monomial(p,k1)$D]$VPoly @@ -121106,96 +121292,96 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where ve > vp => 0 coefficient(coefficient(p.ts,leadingCoefficient e),reductum e) --- coerce(e:IndexedExponents(VarSet)) : % == --- e = 0 => 1 --- monomial(1,leadingSupport e, leadingCoefficient e) * --- (reductum e)::% - --- retract(p:%):IndexedExponents(VarSet) == --- q:Union(IndexedExponents(VarSet),"failed"):=retractIfCan p --- q :: IndexedExponents(VarSet) + coerce(n) == + n::R::% --- retractIfCan(p:%):Union(IndexedExponents(VarSet),"failed") == --- p = 0 => degree p --- reductum(p)=0 and leadingCoefficient(p)=1 => degree p --- "failed" + coerce(c) == + c::% - coerce(n) == n::R::% - coerce(c) == c::% - characteristic == characteristic$R + characteristic == + characteristic$R recip(p) == p case R => (uu:=recip(p::R);uu case "failed" => "failed"; uu::%) "failed" - p == - p case R => -$R p - [p.v, - p.ts]$VPoly - n * p == - p case R => n * p::R - mvar:=p.v - up:=n*p.ts - if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly - c * p == - c = 1 => p - p case R => c * p::R - mvar:=p.v - up:=c*p.ts - if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly - p1 + p2 == - p1 case R and p2 case R => p1 +$R p2 - p1 case R => [p2.v, p1::D + p2.ts]$VPoly - p2 case R => [p1.v, p1.ts + p2::D]$VPoly - p1.v = p2.v => - mvar:=p1.v - up:=p1.ts+p2.ts - if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly - p1.v < p2.v => - [p2.v, p1::D + p2.ts]$VPoly - [p1.v, p1.ts + p2::D]$VPoly + p case R => -$R p + [p.v, - p.ts]$VPoly + + n * p == + p case R => n * p::R + mvar:=p.v + up:=n*p.ts + if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly + + c * p == + c = 1 => p + p case R => c * p::R + mvar:=p.v + up:=c*p.ts + if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly + + p1 + p2 == + p1 case R and p2 case R => p1 +$R p2 + p1 case R => [p2.v, p1::D + p2.ts]$VPoly + p2 case R => [p1.v, p1.ts + p2::D]$VPoly + p1.v = p2.v => + mvar:=p1.v + up:=p1.ts+p2.ts + if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly + p1.v < p2.v => + [p2.v, p1::D + p2.ts]$VPoly + [p1.v, p1.ts + p2::D]$VPoly + + p1 - p2 == + p1 case R and p2 case R => p1 -$R p2 + p1 case R => [p2.v, p1::D - p2.ts]$VPoly + p2 case R => [p1.v, p1.ts - p2::D]$VPoly + p1.v = p2.v => + mvar:=p1.v + up:=p1.ts-p2.ts + if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly + p1.v < p2.v => + [p2.v, p1::D - p2.ts]$VPoly + [p1.v, p1.ts - p2::D]$VPoly - p1 - p2 == - p1 case R and p2 case R => p1 -$R p2 - p1 case R => [p2.v, p1::D - p2.ts]$VPoly - p2 case R => [p1.v, p1.ts - p2::D]$VPoly - p1.v = p2.v => - mvar:=p1.v - up:=p1.ts-p2.ts - if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly - p1.v < p2.v => - [p2.v, p1::D - p2.ts]$VPoly - [p1.v, p1.ts - p2::D]$VPoly + p1 = p2 == + p1 case R => + p2 case R => p1 =$R p2 + false + p2 case R => false + p1.v = p2.v => p1.ts = p2.ts + false - p1 = p2 == - p1 case R => - p2 case R => p1 =$R p2 - false - p2 case R => false - p1.v = p2.v => p1.ts = p2.ts - false + p1 * p2 == + p1 case R => p1::R * p2 + p2 case R => + mvar:=p1.v + up:=p1.ts*p2 + if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly + p1.v = p2.v => + mvar:=p1.v + up:=p1.ts*p2.ts + if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly + p1.v > p2.v => + mvar:=p1.v + up:=p1.ts*p2 + if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly + --- p1.v < p2.v + mvar:=p2.v + up:=p1*p2.ts + if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly - p1 * p2 == - p1 case R => p1::R * p2 - p2 case R => - mvar:=p1.v - up:=p1.ts*p2 - if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly - p1.v = p2.v => - mvar:=p1.v - up:=p1.ts*p2.ts - if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly - p1.v > p2.v => - mvar:=p1.v - up:=p1.ts*p2 - if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly - --- p1.v < p2.v - mvar:=p2.v - up:=p1*p2.ts - if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly + p ^ kp == + p ** (kp pretend NonNegativeInteger) + + p ** kp == + p ** (kp pretend NonNegativeInteger ) + + p ^ k == + p ** k - p ^ kp == p ** (kp pretend NonNegativeInteger) - p ** kp == p ** (kp pretend NonNegativeInteger ) - p ^ k == p ** k p ** k == p case R => p::R ** k -- univariate special case @@ -121206,6 +121392,7 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly if R has IntegralDomain then + UnitCorrAssoc ==> Record(unit:%,canonical:%,associate:%) unitNormal(p) == u,c,a:R @@ -121214,24 +121401,27 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where [u::%,c::%,a::%]$UnitCorrAssoc (u,c,a):= unitNormal(leadingCoefficient(p))$R [u::%,(a*p)::%,a::%]$UnitCorrAssoc + unitCanonical(p) == p case R => unitCanonical(p::R)$R (u,c,a):= unitNormal(leadingCoefficient(p))$R a*p + unit? p == p case R => unit?(p::R)$R false + associates?(p1,p2) == p1 case R => p2 case R and associates?(p1,p2)$R p2 case VPoly and p1.v = p2.v and associates?(p1.ts,p2.ts) if R has approximate then + p1 exquo p2 == p1 case R and p2 case R => a:= (p1::R exquo p2::R) if a case "failed" then "failed" else a::% zero? p1 => p1 --- one? p2 => p1 (p2 = 1) => p1 p1 case R or p2 case VPoly and p1.v < p2.v => "failed" p2 case R or p1.v > p2.v => @@ -121243,7 +121433,7 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where -- In the case where the test succeeds, empirical evidence -- suggests that it can speed up the computation several times, -- but in other cases where there are a lot of variables - -- and p1 and p2 differ only in the low order terms (e.g. p1=p2+1) + -- p1 and p2 differ only in the low order terms (e.g. p1=p2+1) -- it slows exquo down by about 15-20%. p1 = p2 => 1 a:= p1.ts exquo p2.ts @@ -121253,12 +121443,12 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where if ground? (up) then leadingCoefficient(up) else [mvar,up]$VPoly::% else - p1 exquo p2 == + + p1 exquo p2 == p1 case R and p2 case R => a:= (p1::R exquo p2::R) if a case "failed" then "failed" else a::% zero? p1 => p1 --- one? p2 => p1 (p2 = 1) => p1 p1 case R or p2 case VPoly and p1.v < p2.v => "failed" p2 case R or p1.v > p2.v => @@ -121278,18 +121468,20 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly if R has Field then - (p : %) / (r : R) == inv(r) * p + + (p : %) / (r : R) == + inv(r) * p if R has GcdDomain then + content(p) == - p case R => p - c :R :=0 - up:=p.ts --- while not(zero? up) and not(one? c) repeat - while not(zero? up) and not(c = 1) repeat - c:=gcd(c,content leadingCoefficient(up)) - up := reductum up - c + p case R => p + c :R :=0 + up:=p.ts + while not(zero? up) and not(c = 1) repeat + c:=gcd(c,content leadingCoefficient(up)) + up := reductum up + c if R has EuclideanDomain and R has CharacteristicZero and @@ -121299,13 +121491,17 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where p case R => p gcd(coefficients univariate(p,mvar))$pgcd - gcd(p1,p2) == gcd(p1,p2)$pgcd + gcd(p1,p2) == + gcd(p1,p2)$pgcd - gcd(lp:List %) == gcd(lp)$pgcd + gcd(lp:List %) == + gcd(lp)$pgcd - gcdPolynomial(a:SUP $,b:SUP $):SUP $ == gcd(a,b)$pgcd + gcdPolynomial(a:SUP $,b:SUP $):SUP $ == + gcd(a,b)$pgcd else if R has GcdDomain then + content(p,mvar) == p case R => p content univariate(p,mvar) @@ -121325,6 +121521,7 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly if R has FloatingPointSystem then + -- eventually need a better notion of gcd's over floats -- this essentially computes the gcds of the monomial contents gcdPolynomial(a:SUP $,b:SUP $):SUP $ == @@ -121367,12 +121564,8 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where p case R => p::R "failed" --- leadingCoefficientRecursive(p:%):% == --- p case R => p --- leadingCoefficient p.ts - mymerge:(List VarSet,List VarSet) ->List VarSet - mymerge(l:List VarSet,m:List VarSet):List VarSet == + mymerge(l:List VarSet,m:List VarSet):List VarSet == empty? l => m empty? m => l first l = first m => @@ -121407,8 +121600,11 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where p case R => "failed" p.v - eval(p,mvar,pval) == univariate(p,mvar)(pval) - eval(p,mvar,val) == univariate(p,mvar)(val) + eval(p,mvar,pval) == + univariate(p,mvar)(pval) + + eval(p,mvar,val) == + univariate(p,mvar)(val) evalSortedVarlist(p,Lvar,Lpval):% == p case R => p @@ -121440,7 +121636,8 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where mvar > p.v => 0 -- might as well take advantage of the order max(degree(leadingCoefficient p.ts,mvar),degree(red p,mvar)) - degree(p,Lvar) == [degree(p,mvar) for mvar in Lvar] + degree(p,Lvar) == + [degree(p,mvar) for mvar in Lvar] degree p == p case R => 0 @@ -121475,6 +121672,7 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where tdeg if R has CommutativeRing then + differentiate(p,mvar) == p case R => 0 mvar=p.v => @@ -121487,12 +121685,6 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where p case R => p leadingCoefficient(leadingCoefficient(p.ts)) --- trailingCoef(p) == --- p case R => p --- coef(p.ts,0) case R => coef(p.ts,0) --- trailingCoef(red p) --- TrailingCoef(p) == trailingCoef(p) - leadingMonomial p == p case R => p monomial(leadingMonomial leadingCoefficient(p.ts), @@ -121502,29 +121694,6 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where p case R => 0 p - leadingMonomial p - --- if R is Integer then --- pgcd := PolynomialGcdPackage(%,VarSet) --- gcd(p1,p2) == --- gcd(p1,p2)$pgcd --- --- else if R is RationalNumber then --- gcd(p1,p2) == --- mrat:= MRationalFactorize(VarSet,%) --- gcd(p1,p2)$mrat --- --- else gcd(p1,p2) == --- p1 case R => --- p2 case R => gcd(p1,p2)$R::% --- p1 = 0 => p2 --- gcd(p1, content(p2.ts)) --- p2 case R => --- p2 = 0 => p1 --- gcd(p2, content(p1.ts)) --- p1.v < p2.v => gcd(p1, content(p2.ts)) --- p1.v > p2.v => gcd(content(p1.ts), p2) --- PSimp(p1.v, gcd(p1.ts, p2.ts)) - \end{chunk} \begin{chunk}{SMP.dotabb} "SMP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=SMP"] @@ -123300,7 +123469,6 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with kBound: NonNegativeInteger := 63 upmp := UnivariatePolynomialMultiplicationPackage(R,%) - if R has FieldOfPrimeCharacteristic then p ** np == p ** (np pretend NonNegativeInteger) p ^ np == p ** (np pretend NonNegativeInteger) @@ -123308,13 +123476,13 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with p ** n == null p => 0 zero? n => 1 --- one? n => p (n = 1) => p empty? p.rest => zero?(cc:=p.first.c ** n) => 0 [[n * p.first.k, cc]] -- not worth doing special trick if characteristic is too small - if characteristic()$R < 3 then return expt(p,n pretend PositiveInteger)$RepeatedSquaring(%) + if characteristic()$R < 3 then _ + return expt(p,n pretend PositiveInteger)$RepeatedSquaring(%) y:%:=1 -- break up exponent in qn * characteristic + rn -- exponentiating by the characteristic is fast @@ -123326,19 +123494,28 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with if rn > 1 then y:= y * binomThmExpt([p.first], p.rest, rn) zero? qn => return y -- raise to the characteristic power - p:= [[t.k * characteristic()$R , primeFrobenius(t.c)$R ]$Term for t in p] + p:= [[t.k * characteristic()$R , primeFrobenius(t.c)$R ]$Term _ + for t in p] rec := divide(qn, characteristic()$R) qn:= rec.quotient rn:= rec.remainder y + zero?(p): Boolean == + empty?(p) + + one?(p):Boolean == + not empty? p and (empty? rest p and zero? first(p).k and one? first(p).c) + one?(p):Boolean == + not empty? p and (empty? rest p and zero? first(p).k and (first(p).c = 1)) + + ground?(p): Boolean == + empty? p or (empty? rest p and zero? first(p).k) + + multiplyExponents(p,n) == + [ [u.k*n,u.c] for u in p] - zero?(p): Boolean == empty?(p) --- one?(p):Boolean == not empty? p and (empty? rest p and zero? first(p).k and one? first(p).c) - one?(p):Boolean == not empty? p and (empty? rest p and zero? first(p).k and (first(p).c = 1)) - ground?(p): Boolean == empty? p or (empty? rest p and zero? first(p).k) - multiplyExponents(p,n) == [ [u.k*n,u.c] for u in p] divideExponents(p,n) == null p => p m:= (p.first.k :: Integer exquo n::Integer) @@ -123346,6 +123523,7 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with u:= divideExponents(p.rest,n) u case "failed" => "failed" [[m::Integer::NonNegativeInteger,p.first.c],:u] + karatsubaDivide(p, n) == zero? n => [p, 0] lowp: Rep := p @@ -123357,10 +123535,13 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with lowp := rest lowp highp := cons([subtractIfCan(t.k,n)::NonNegativeInteger,t.c]$Term,highp) [ reverse highp, lowp] + shiftRight(p, n) == [[subtractIfCan(t.k,n)::NonNegativeInteger,t.c]$Term for t in p] + shiftLeft(p, n) == [[t.k + n,t.c]$Term for t in p] + pomopo!(p1,r,e,p2) == rout:%:= [] for tm in p2 repeat diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 7440e51..bf5cc4b 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -7020,7 +7020,7 @@ modeset otherwise. It creates the attributed tree. \calls{interpret1}{putTarget} \calls{interpret1}{bottomUp} \calls{interpret1}{getArgValue} -\calls{interpret1}{objNew} +\calls{interpret1}{mkObj} \calls{interpret1}{getValue} \calls{interpret1}{interpret2} \calls{interpret1}{keyedSystemError} @@ -7042,7 +7042,7 @@ modeset otherwise. It creates the attributed tree. (setq argVal (|getArgValue| node newRootMode)) (cond ((and argVal (null |$genValue|)) - (|objNew| argVal newRootMode)) + (mkObj argVal newRootMode)) ((and argVal (setq val (|getValue| node))) (|interpret2| val newRootMode posnForm)) (t @@ -7056,7 +7056,7 @@ coerceInteractive, so it only does the JENKS cases ALBI \calls{interpret2}{objVal} \calls{interpret2}{objMode} \calls{interpret2}{member} -\calls{interpret2}{objNew} +\calls{interpret2}{mkObj} \calls{interpret2}{systemErrorHere} \calls{interpret2}{coerceInteractive} \calls{interpret2}{throwKeyedMsgCannotCoerceWithValue} @@ -7078,9 +7078,9 @@ coerceInteractive, so it only does the JENKS cases ALBI ((and (consp x) (progn (setq op (qcar x)) t) (|member| op '(map stream))) - (|objNew| x m1)) + (mkObj x m1)) ((equal m1 |$EmptyMode|) - (|objNew| x m)) + (mkObj x m)) (t (|systemErrorHere| "interpret2")))) (m1 @@ -7098,7 +7098,7 @@ in environment \verb|$e| into \verb|$InteractiveFrame| It is controlled with the {\tt )se me any} command. \calls{recordAndPrint}{output} \calls{recordAndPrint}{putHist} -\calls{recordAndPrint}{objNewWrap} +\calls{recordAndPrint}{mkObjWrap} \calls{recordAndPrint}{printTypeAndTime} \calls{recordAndPrint}{printStorage} \calls{recordAndPrint}{printStatisticsSummary} @@ -7145,7 +7145,7 @@ It is controlled with the {\tt )se me any} command. (when (or (not (equal md |$Void|)) |$printVoidIfTrue|) (unless |$collectOutput| (terpri |$algebraOutputStream|)) (unless |$QuietCommand| (|output| xp mdp))) - (|putHist| '% '|value| (|objNewWrap| x md) |$e|) + (|putHist| '% '|value| (mkObjWrap x md) |$e|) (when (or |$printTimeIfTrue| |$printTypeIfTrue|) (|printTypeAndTime| xp mdp)) (when |$printStorageIfTrue| (|printStorage|)) @@ -7207,7 +7207,7 @@ It is controlled with the {\tt )se me any} command. \calls{printTypeAndTimeNormal}{retract} \calls{printTypeAndTimeNormal}{qcar} \calls{printTypeAndTimeNormal}{retract} -\calls{printTypeAndTimeNormal}{objNewWrap} +\calls{printTypeAndTimeNormal}{mkObjWrap} \calls{printTypeAndTimeNormal}{objMode} \calls{printTypeAndTimeNormal}{sameUnionBranch} \calls{printTypeAndTimeNormal}{makeLongTimeString} @@ -7229,7 +7229,7 @@ It is controlled with the {\tt )se me any} command. |$interpreterTimedNames| |$interpreterTimedClasses|)) (cond ((and (consp m) (eq (qcar m) '|Union|)) - (setq xp (|retract| (|objNewWrap| x m))) + (setq xp (|retract| (mkObjWrap x m))) (setq mp (|objMode| xp)) (setq m (cons '|Union| @@ -13354,45 +13354,34 @@ code, e.g., parts of a function that is being constructed. These are the new structure functions. +\begin{center} +\includegraphics{ps/v5mkObj.eps}\\ +{\bf {\Large Object representation}} +\end{center} + \defmacro{mkObj} \begin{chunk}{defmacro mkObj} -(defmacro |mkObj| (val mode) +(defmacro mkObj (val mode) `(cons ,mode ,val)) \end{chunk} +\begin{center} +\includegraphics{ps/v5mkObjWrap.eps}\\ +{\bf {\Large Object representation}} +\end{center} + \defmacro{mkObjWrap} \calls{mkObjWrap}{wrap} \begin{chunk}{defmacro mkObjWrap} -(defmacro |mkObjWrap| (val mode) +(defmacro mkObjWrap (val mode) `(cons ,mode (|wrap| ,val))) \end{chunk} \defmacro{mkObjCode} \begin{chunk}{defmacro mkObjCode} -(defmacro |mkObjCode| (val mode) - `(cons 'cons (cons (mkq ,mode) (cons ,val nil)))) - -\end{chunk} - -\defmacro{objNew} -\begin{chunk}{defmacro objNew} -(defmacro |objNew| (val mode) - `(cons ,mode ,val)) - -\end{chunk} - -\defmacro{objNewWrap} -\begin{chunk}{defmacro objNewWrap} -(defmacro |objNewWrap| (val mode) - `(cons ,mode (|wrap| ,val))) - -\end{chunk} - -\defmacro{objNewCode} -\begin{chunk}{defmacro objNewCode} -(defmacro |objNewCode| (val mode) +(defmacro mkObjCode (val mode) `(cons 'cons (cons (mkq ,mode) (cons ,val nil)))) \end{chunk} @@ -37559,7 +37548,7 @@ This reports the traced functions \calls{coerceTraceArgs2E}{coerceSpadArgs2E} \calls{coerceTraceArgs2E}{objValUnwrap} \calls{coerceTraceArgs2E}{coerceInteractive} -\calls{coerceTraceArgs2E}{objNewWrap} +\calls{coerceTraceArgs2E}{mkObjWrap} \usesdollar{coerceTraceArgs2E}{OutputForm} \usesdollar{coerceTraceArgs2E}{mathTraceList} \usesdollar{coerceTraceArgs2E}{tracedMapSignatures} @@ -37593,7 +37582,7 @@ This reports the traced functions (list '= name (|objValUnwrap| (|coerceInteractive| - (|objNewWrap| arg type) |$OutputForm|))) t0))))) + (mkObjWrap arg type) |$OutputForm|))) t0))))) ((spadsysnamep (pname name)) (reverse (cdr (reverse args)))) (t args)))) @@ -37604,7 +37593,7 @@ This reports the traced functions \calls{coerceSpadArgs2E}{exit} \calls{coerceSpadArgs2E}{objValUnwrap} \calls{coerceSpadArgs2E}{coerceInteractive} -\calls{coerceSpadArgs2E}{objNewWrap} +\calls{coerceSpadArgs2E}{mkObjWrap} \usesdollar{coerceSpadArgs2E}{streamCount} \usesdollar{coerceSpadArgs2E}{OutputForm} \usesdollar{coerceSpadArgs2E}{tracedSpadModemap} @@ -37636,7 +37625,7 @@ This reports the traced functions (cons name (cons (|objValUnwrap| (|coerceInteractive| - (|objNewWrap| arg type) + (mkObjWrap arg type) |$OutputForm|)) nil))) t0))))))) @@ -37674,7 +37663,7 @@ This reports the traced functions \calls{coerceTraceFunValue2E}{lassoc} \calls{coerceTraceFunValue2E}{objValUnwrap} \calls{coerceTraceFunValue2E}{coerceInteractive} -\calls{coerceTraceFunValue2E}{objNewWrap} +\calls{coerceTraceFunValue2E}{mkObjWrap} \usesdollar{coerceTraceFunValue2E}{tracedMapSignatures} \usesdollar{coerceTraceFunValue2E}{OutputForm} \usesdollar{coerceTraceFunValue2E}{mathTraceList} @@ -37687,7 +37676,7 @@ This reports the traced functions ((spadsysnamep (pname tracename)) (|coerceSpadFunValue2E| |value|)) ((setq u (lassoc subname |$tracedMapSignatures|)) (|objValUnwrap| - (|coerceInteractive| (|objNewWrap| |value| (car u)) |$OutputForm|))) + (|coerceInteractive| (mkObjWrap |value| (car u)) |$OutputForm|))) (t |value|)) |value|))) @@ -37696,7 +37685,7 @@ This reports the traced functions \defun{coerceSpadFunValue2E}{coerceSpadFunValue2E} \calls{coerceSpadFunValue2E}{objValUnwrap} \calls{coerceSpadFunValue2E}{coerceInteractive} -\calls{coerceSpadFunValue2E}{objNewWrap} +\calls{coerceSpadFunValue2E}{mkObjWrap} \usesdollar{coerceSpadFunValue2E}{streamCount} \usesdollar{coerceSpadFunValue2E}{tracedSpadModemap} \usesdollar{coerceSpadFunValue2E}{OutputForm} @@ -37707,7 +37696,7 @@ This reports the traced functions (setq |$streamCount| 0) (|objValUnwrap| (|coerceInteractive| - (|objNewWrap| |value| (car |$tracedSpadModemap|)) + (mkObjWrap |value| (car |$tracedSpadModemap|)) |$OutputForm|)))) \end{chunk} @@ -41205,7 +41194,7 @@ There are several special modes used in these functions: \calls{getAndEvalConstructorArgument}{objVal} \calls{getAndEvalConstructorArgument}{isLocalVar} \calls{getAndEvalConstructorArgument}{compFailure} -\calls{getAndEvalConstructorArgument}{objNewWrap} +\calls{getAndEvalConstructorArgument}{mkObjWrap} \calls{getAndEvalConstructorArgument}{timedEVALFUN} \begin{chunk}{defun getAndEvalConstructorArgument} (defun |getAndEvalConstructorArgument| (tree) @@ -41217,7 +41206,7 @@ There are several special modes used in these functions: ((|isLocalVar| (|objVal| triple)) (|compFailure| " Local variable or parameter used in type")) (t - (|objNewWrap| (|timedEVALFUN| (|objVal| triple)) (|objMode| triple)))))) + (mkObjWrap (|timedEVALFUN| (|objVal| triple)) (|objMode| triple)))))) \end{chunk} @@ -44634,6 +44623,30 @@ Given a form, $u$, we try to recover the input line that created it. \end{chunk} +\section{InputForm} + +\defun{mkobjFn}{called by interpret function} +\begin{chunk}{defun mkObjFn 0} +(defun |mkObjFn| (val mode) + (cons mode val)) + +\end{chunk} + +\defun{objValFn}{called by interpret function} +\begin{chunk}{defun objValFn 0} +(defun |objValFn| (obj) + (cdr obj)) + +\end{chunk} + +\defun{objModeFn}{called by interpret function} +\begin{chunk}{defun objModeFn 0} +(defun |objModeFn| (obj) + (car obj)) + +\end{chunk} + + \section{U16Matrix} \defmacro{aref2U16} @@ -44800,7 +44813,7 @@ Given a form, $u$, we try to recover the input line that created it. \calls{retract}{isWrapped} \calls{retract}{qcar} \calls{retract}{retract1} -\calls{retract}{objNew} +\calls{retract}{mkObj} \refsdollar{retract}{EmptyMode} \begin{chunk}{defun retract} (defun |retract| (object) @@ -44815,10 +44828,10 @@ Given a form, $u$, we try to recover the input line that created it. (t (setq val (|objVal| object)) (cond - ((equal type |$PositiveInteger|) (|objNew| val |$NonNegativeInteger|)) - ((equal type |$NonNegativeInteger|) (|objNew| val |$Integer|)) + ((equal type |$PositiveInteger|) (mkObj val |$NonNegativeInteger|)) + ((equal type |$NonNegativeInteger|) (mkObj val |$Integer|)) ((and (equal type |$Integer|) (typep (|unwrap| val) 'fixnum)) - (|objNew| val |$SingleInteger|)) + (mkObj val |$SingleInteger|)) (t (cond ((or (eql 1 (|#| type)) @@ -44858,10 +44871,10 @@ Given a form, $u$, we try to recover the input line that created it. '|failed|) (t (cond - ((eq (setq ans (retract1 (|objNew| val type))) '|failed|) + ((eq (setq ans (retract1 (mkObj val type))) '|failed|) ans) (t - (|objNew| (|objVal| ans) (|objMode| ans))))))))))) + (mkObj (|objVal| ans) (|objMode| ans))))))))))) \end{chunk} @@ -44873,7 +44886,7 @@ Given a form, $u$, we try to recover the input line that created it. (cond ((null (|isValidType| source)) (|throwKeyedMsg| 'S2IE0004 (list source))) ((null (|isValidType| target)) (|throwKeyedMsg| 'S2IE0004 (list target))) - ((setq xp (|coerceInteractive| (|objNewWrap| x source) target)) + ((setq xp (|coerceInteractive| (mkObjWrap x source) target)) (|objValUnwrap| xp)) (t (|throwKeyedMsgCannotCoerceWithValue| (|wrap| x) source target))))) @@ -44889,7 +44902,7 @@ Given a form, $u$, we try to recover the input line that created it. (setq |$useConvertForCoercions| t) (setq source (|devaluate| source)) (setq target (|devaluate| target)) - (setq u (|coerceInteractive| (|objNewWrap| p source) target)) + (setq u (|coerceInteractive| (mkObjWrap p source) target)) (if u (|objValUnwrap| u) (|error| (list "can't convert" p "of mode" source "to mode" target))))) @@ -58511,9 +58524,6 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defmacro objCodeVal} \getchunk{defmacro objCodeMode} \getchunk{defmacro objMode} -\getchunk{defmacro objNew} -\getchunk{defmacro objNewCode} -\getchunk{defmacro objNewWrap} \getchunk{defmacro objSetMode} \getchunk{defmacro objSetVal} \getchunk{defmacro objVal} @@ -58672,6 +58682,7 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun makeInitialModemapFrame 0} \getchunk{defun manexp 0} \getchunk{defun member 0} +\getchunk{defun mkObjFn 0} \getchunk{defun monitor-add 0} \getchunk{defun monitor-apropos 0} \getchunk{defun monitor-autoload 0} @@ -58717,6 +58728,8 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun npPush 0} \getchunk{defun objEnv 0} +\getchunk{defun objModeFn 0} +\getchunk{defun objValFn 0} \getchunk{defun opTran 0} \getchunk{defun pfAndLeft 0} diff --git a/books/ps/v5mkObj.eps b/books/ps/v5mkObj.eps new file mode 100644 index 0000000..0b7c46b --- /dev/null +++ b/books/ps/v5mkObj.eps @@ -0,0 +1,296 @@ +%!PS-Adobe-3.0 EPSF-3.0 +%%Creator: jlibeps 0.1, https://sourceforge.net/projects/jlibeps/ +%%Title: LaTeXDraw +%%CreationDate: Wed Nov 12 18:56:23 EST 2014 +%%BoundingBox: 0 0 111 50 +%%DocumentData: Clean7Bit +%%DocumentProcessColors: Black +%%ColorUsage: Color +%%Origin: 0 0 +%%Pages: 1 +%%Page: 1 1 +%%EndComments + +gsave +-34.0 65.0 translate +2.0 setlinewidth +10.0 setmiterlimit +0 setlinejoin +0 setlinecap +[ ] 0 setdash +0.0 0.0 0.0 setrgbcolor +0.0 0.0 0.0 setrgbcolor +newpath +40.0 -21.0 moveto +139.0 -21.0 lineto +139.0 -58.0 lineto +40.0 -58.0 lineto +40.0 -21.0 lineto +closepath +stroke +newpath +0.0 0.0 0.0 setrgbcolor +0.0 0.0 0.0 setrgbcolor +2.0 setlinewidth +10.0 setmiterlimit +0 setlinejoin +0 setlinecap +[ ] 0 setdash +0.0 0.0 0.0 setrgbcolor +newpath +90.0 -23.0 moveto +90.0 -59.0 lineto +stroke +newpath +2.0 setlinewidth +10.0 setmiterlimit +0 setlinejoin +0 setlinecap +[ ] 0 setdash +0.0 0.0 0.0 setrgbcolor +0.0 0.0 0.0 setrgbcolor +newpath +48.953125 -38.42578 moveto +49.539062 -37.839844 49.884766 -37.50293 49.990234 -37.41504 curveto +50.253906 -37.192383 50.538086 -37.01953 50.842773 -36.896484 curveto +51.14746 -36.773438 51.44922 -36.711914 51.748047 -36.711914 curveto +52.251953 -36.711914 52.685547 -36.8584 53.04883 -37.151367 curveto +53.41211 -37.444336 53.655273 -37.86914 53.77832 -38.42578 curveto +54.381836 -37.722656 54.8916 -37.26123 55.307617 -37.041504 curveto +55.723633 -36.821777 56.151367 -36.711914 56.59082 -36.711914 curveto +57.018555 -36.711914 57.39795 -36.821777 57.729004 -37.041504 curveto +58.06006 -37.26123 58.322266 -37.620117 58.515625 -38.118164 curveto +58.64453 -38.458008 58.708984 -38.99121 58.708984 -39.717773 curveto +58.708984 -43.180664 lineto +58.708984 -43.68457 58.74707 -44.030273 58.823242 -44.217773 curveto +58.881836 -44.34668 58.990234 -44.456543 59.148438 -44.547363 curveto +59.30664 -44.638184 59.564453 -44.683594 59.921875 -44.683594 curveto +59.921875 -45.0 lineto +55.94922 -45.0 lineto +55.94922 -44.683594 lineto +56.11621 -44.683594 lineto +56.461914 -44.683594 56.731445 -44.61621 56.924805 -44.481445 curveto +57.05957 -44.387695 57.15625 -44.23828 57.214844 -44.033203 curveto +57.23828 -43.933594 57.25 -43.649414 57.25 -43.180664 curveto +57.25 -39.717773 lineto +57.25 -39.061523 57.1709 -38.598633 57.012695 -38.3291 curveto +56.78418 -37.9541 56.41797 -37.7666 55.914062 -37.7666 curveto +55.603516 -37.7666 55.291504 -37.84424 54.978027 -37.99951 curveto +54.66455 -38.154785 54.285156 -38.44336 53.839844 -38.865234 curveto +53.822266 -38.961914 lineto +53.839844 -39.339844 lineto +53.839844 -43.180664 lineto +53.839844 -43.731445 53.870605 -44.07422 53.93213 -44.208984 curveto +53.993652 -44.34375 54.109375 -44.456543 54.279297 -44.547363 curveto +54.44922 -44.638184 54.739258 -44.683594 55.149414 -44.683594 curveto +55.149414 -45.0 lineto +51.08008 -45.0 lineto +51.08008 -44.683594 lineto +51.52539 -44.683594 51.831543 -44.63086 51.998535 -44.52539 curveto +52.165527 -44.41992 52.28125 -44.26172 52.345703 -44.05078 curveto +52.375 -43.95117 52.38965 -43.661133 52.38965 -43.180664 curveto +52.38965 -39.717773 lineto +52.38965 -39.061523 52.29297 -38.589844 52.09961 -38.302734 curveto +51.841797 -37.927734 51.481445 -37.740234 51.018555 -37.740234 curveto +50.70215 -37.740234 50.38867 -37.825195 50.078125 -37.995117 curveto +49.591797 -38.25293 49.216797 -38.54297 48.953125 -38.865234 curveto +48.953125 -43.180664 lineto +48.953125 -43.708008 48.989746 -44.05078 49.06299 -44.208984 curveto +49.13623 -44.367188 49.24463 -44.48584 49.388184 -44.56494 curveto +49.53174 -44.644043 49.823242 -44.683594 50.262695 -44.683594 curveto +50.262695 -45.0 lineto +46.28125 -45.0 lineto +46.28125 -44.683594 lineto +46.65039 -44.683594 46.908203 -44.644043 47.054688 -44.56494 curveto +47.20117 -44.48584 47.3125 -44.359863 47.38867 -44.18701 curveto +47.464844 -44.01416 47.50293 -43.67871 47.50293 -43.180664 curveto +47.50293 -40.104492 lineto +47.50293 -39.219727 47.476562 -38.648438 47.42383 -38.390625 curveto +47.382812 -38.197266 47.31836 -38.063965 47.23047 -37.990723 curveto +47.14258 -37.91748 47.02246 -37.88086 46.870117 -37.88086 curveto +46.706055 -37.88086 46.509766 -37.924805 46.28125 -38.012695 curveto +46.149414 -37.69629 lineto +48.575195 -36.711914 lineto +48.953125 -36.711914 lineto +closepath +64.5 -36.711914 moveto +65.71875 -36.711914 66.697266 -37.174805 67.43555 -38.100586 curveto +68.0625 -38.8916 68.37598 -39.799805 68.37598 -40.825195 curveto +68.37598 -41.5459 68.203125 -42.27539 67.85742 -43.01367 curveto +67.51172 -43.751953 67.035645 -44.308594 66.4292 -44.683594 curveto +65.822754 -45.058594 65.14746 -45.246094 64.40332 -45.246094 curveto +63.19043 -45.246094 62.226562 -44.762695 61.51172 -43.7959 curveto +60.908203 -42.981445 60.606445 -42.067383 60.606445 -41.05371 curveto +60.606445 -40.31543 60.78955 -39.581543 61.15576 -38.85205 curveto +61.521973 -38.12256 62.003906 -37.583496 62.601562 -37.234863 curveto +63.19922 -36.88623 63.83203 -36.711914 64.5 -36.711914 curveto +closepath +64.22754 -37.283203 moveto +63.916992 -37.283203 63.60498 -37.37549 63.291504 -37.56006 curveto +62.978027 -37.74463 62.72461 -38.06836 62.53125 -38.53125 curveto +62.33789 -38.99414 62.24121 -39.588867 62.24121 -40.31543 curveto +62.24121 -41.487305 62.47412 -42.498047 62.93994 -43.347656 curveto +63.40576 -44.197266 64.01953 -44.62207 64.78125 -44.62207 curveto +65.34961 -44.62207 65.81836 -44.387695 66.1875 -43.918945 curveto +66.55664 -43.450195 66.74121 -42.64453 66.74121 -41.501953 curveto +66.74121 -40.072266 66.43359 -38.947266 65.81836 -38.126953 curveto +65.40234 -37.564453 64.87207 -37.283203 64.22754 -37.283203 curveto +closepath +75.24902 -44.094727 moveto +74.856445 -44.504883 74.47266 -44.799316 74.09766 -44.978027 curveto +73.72266 -45.15674 73.31836 -45.246094 72.884766 -45.246094 curveto +72.00586 -45.246094 71.23828 -44.878418 70.58203 -44.143066 curveto +69.92578 -43.407715 69.59766 -42.46289 69.59766 -41.308594 curveto +69.59766 -40.154297 69.96094 -39.098145 70.6875 -38.140137 curveto +71.41406 -37.18213 72.34863 -36.703125 73.49121 -36.703125 curveto +74.200195 -36.703125 74.78613 -36.92871 75.24902 -37.379883 curveto +75.24902 -35.89453 lineto +75.24902 -34.97461 75.22705 -34.40918 75.183105 -34.198242 curveto +75.13916 -33.987305 75.07031 -33.84375 74.97656 -33.76758 curveto +74.88281 -33.691406 74.765625 -33.65332 74.625 -33.65332 curveto +74.47266 -33.65332 74.27051 -33.700195 74.018555 -33.793945 curveto +73.9043 -33.48633 lineto +76.30371 -32.501953 lineto +76.69922 -32.501953 lineto +76.69922 -41.80957 lineto +76.69922 -42.75293 76.72119 -43.328613 76.76514 -43.53662 curveto +76.80908 -43.74463 76.879395 -43.88965 76.976074 -43.97168 curveto +77.072754 -44.05371 77.18555 -44.094727 77.31445 -44.094727 curveto +77.47266 -44.094727 77.68359 -44.04492 77.947266 -43.945312 curveto +78.043945 -44.25293 lineto +75.65332 -45.246094 lineto +75.24902 -45.246094 lineto +closepath +75.24902 -43.479492 moveto +75.24902 -39.331055 lineto +75.21387 -38.932617 75.1084 -38.569336 74.93262 -38.24121 curveto +74.756836 -37.913086 74.523926 -37.665527 74.23389 -37.498535 curveto +73.94385 -37.331543 73.66113 -37.248047 73.38574 -37.248047 curveto +72.87012 -37.248047 72.41016 -37.479492 72.00586 -37.942383 curveto +71.47266 -38.551758 71.206055 -39.442383 71.206055 -40.614258 curveto +71.206055 -41.79785 71.46387 -42.70459 71.97949 -43.334473 curveto +72.49512 -43.964355 73.069336 -44.279297 73.70215 -44.279297 curveto +74.23535 -44.279297 74.75098 -44.012695 75.24902 -43.479492 curveto +closepath +79.916016 -39.981445 moveto +79.91016 -41.176758 80.200195 -42.114258 80.78613 -42.793945 curveto +81.37207 -43.473633 82.06055 -43.813477 82.85156 -43.813477 curveto +83.37891 -43.813477 83.8374 -43.668457 84.22705 -43.378418 curveto +84.6167 -43.08838 84.94336 -42.591797 85.20703 -41.88867 curveto +85.47949 -42.064453 lineto +85.356445 -42.867188 84.99902 -43.598145 84.40723 -44.257324 curveto +83.81543 -44.916504 83.07422 -45.246094 82.18359 -45.246094 curveto +81.2168 -45.246094 80.38916 -44.86963 79.70068 -44.1167 curveto +79.01221 -43.36377 78.66797 -42.351562 78.66797 -41.08008 curveto +78.66797 -39.703125 79.020996 -38.629395 79.72705 -37.858887 curveto +80.433105 -37.08838 81.319336 -36.703125 82.38574 -36.703125 curveto +83.288086 -36.703125 84.0293 -37.00049 84.609375 -37.595215 curveto +85.18945 -38.18994 85.47949 -38.98535 85.47949 -39.981445 curveto +closepath +79.916016 -39.47168 moveto +83.64258 -39.47168 lineto +83.61328 -38.956055 83.55176 -38.592773 83.45801 -38.381836 curveto +83.31152 -38.05371 83.09326 -37.7959 82.80322 -37.6084 curveto +82.51318 -37.4209 82.20996 -37.32715 81.893555 -37.32715 curveto +81.40723 -37.32715 80.97217 -37.516113 80.58838 -37.894043 curveto +80.20459 -38.271973 79.98047 -38.79785 79.916016 -39.47168 curveto +closepath +fill +newpath +0.0 0.0 0.0 setrgbcolor +0.0 0.0 0.0 setrgbcolor +newpath +104.149414 -36.94922 moveto +107.9375 -36.94922 lineto +107.9375 -37.274414 lineto +107.69141 -37.274414 lineto +107.46289 -37.274414 107.288574 -37.33008 107.16846 -37.441406 curveto +107.04834 -37.552734 106.98828 -37.70215 106.98828 -37.88965 curveto +106.98828 -38.094727 107.049805 -38.33789 107.17285 -38.61914 curveto +109.04492 -43.066406 lineto +110.92578 -38.45215 lineto +111.06055 -38.124023 111.12793 -37.875 111.12793 -37.70508 curveto +111.12793 -37.623047 111.10449 -37.555664 111.05762 -37.50293 curveto +110.993164 -37.41504 110.91113 -37.35498 110.81152 -37.322754 curveto +110.711914 -37.290527 110.509766 -37.274414 110.20508 -37.274414 curveto +110.20508 -36.94922 lineto +112.83301 -36.94922 lineto +112.83301 -37.274414 lineto +112.52832 -37.29785 112.31738 -37.359375 112.200195 -37.458984 curveto +111.99512 -37.634766 111.81055 -37.927734 111.646484 -38.33789 curveto +108.79004 -45.246094 lineto +108.42969 -45.246094 lineto +105.555664 -38.45215 lineto +105.42676 -38.135742 105.30371 -37.90869 105.18652 -37.770996 curveto +105.069336 -37.6333 104.91992 -37.51758 104.73828 -37.42383 curveto +104.63867 -37.371094 104.44238 -37.32129 104.149414 -37.274414 curveto +closepath +118.12402 -43.839844 moveto +117.29785 -44.478516 116.7793 -44.847656 116.56836 -44.947266 curveto +116.25195 -45.09375 115.91504 -45.166992 115.55762 -45.166992 curveto +115.00098 -45.166992 114.54248 -44.976562 114.18213 -44.595703 curveto +113.82178 -44.214844 113.6416 -43.713867 113.6416 -43.092773 curveto +113.6416 -42.700195 113.72949 -42.36035 113.90527 -42.073242 curveto +114.14551 -41.674805 114.56299 -41.299805 115.157715 -40.948242 curveto +115.75244 -40.59668 116.74121 -40.168945 118.12402 -39.66504 curveto +118.12402 -39.348633 lineto +118.12402 -38.5459 117.99658 -37.995117 117.7417 -37.69629 curveto +117.48682 -37.39746 117.11621 -37.248047 116.62988 -37.248047 curveto +116.26074 -37.248047 115.96777 -37.347656 115.75098 -37.546875 curveto +115.52832 -37.746094 115.41699 -37.97461 115.41699 -38.23242 curveto +115.43457 -38.742188 lineto +115.43457 -39.01172 115.36572 -39.219727 115.22803 -39.36621 curveto +115.09033 -39.512695 114.91016 -39.585938 114.6875 -39.585938 curveto +114.4707 -39.585938 114.29346 -39.509766 114.15576 -39.35742 curveto +114.01807 -39.20508 113.94922 -38.99707 113.94922 -38.7334 curveto +113.94922 -38.229492 114.20703 -37.7666 114.72266 -37.344727 curveto +115.23828 -36.92285 115.961914 -36.711914 116.893555 -36.711914 curveto +117.6084 -36.711914 118.194336 -36.83203 118.65137 -37.072266 curveto +118.99707 -37.253906 119.25195 -37.538086 119.416016 -37.924805 curveto +119.521484 -38.176758 119.57422 -38.692383 119.57422 -39.47168 curveto +119.57422 -42.20508 lineto +119.57422 -42.972656 119.58887 -43.44287 119.618164 -43.615723 curveto +119.64746 -43.788574 119.6958 -43.904297 119.76318 -43.96289 curveto +119.83057 -44.021484 119.9082 -44.05078 119.99609 -44.05078 curveto +120.08984 -44.05078 120.171875 -44.030273 120.24219 -43.989258 curveto +120.365234 -43.913086 120.60254 -43.69922 120.9541 -43.347656 curveto +120.9541 -43.839844 lineto +120.29785 -44.71875 119.6709 -45.158203 119.07324 -45.158203 curveto +118.78613 -45.158203 118.55762 -45.058594 118.387695 -44.859375 curveto +118.21777 -44.660156 118.12988 -44.320312 118.12402 -43.839844 curveto +closepath +118.12402 -43.268555 moveto +118.12402 -40.20117 lineto +117.23926 -40.552734 116.66797 -40.801758 116.41016 -40.948242 curveto +115.947266 -41.206055 115.61621 -41.475586 115.41699 -41.756836 curveto +115.21777 -42.038086 115.118164 -42.345703 115.118164 -42.679688 curveto +115.118164 -43.101562 115.24414 -43.45166 115.49609 -43.72998 curveto +115.74805 -44.0083 116.038086 -44.14746 116.36621 -44.14746 curveto +116.81152 -44.14746 117.39746 -43.854492 118.12402 -43.268555 curveto +closepath +124.331055 -32.501953 moveto +124.331055 -43.180664 lineto +124.331055 -43.68457 124.367676 -44.018555 124.44092 -44.182617 curveto +124.51416 -44.34668 124.62695 -44.47119 124.7793 -44.556152 curveto +124.93164 -44.641113 125.21582 -44.683594 125.631836 -44.683594 curveto +125.631836 -45.0 lineto +121.68555 -45.0 lineto +121.68555 -44.683594 lineto +122.05469 -44.683594 122.30664 -44.645508 122.44141 -44.569336 curveto +122.57617 -44.493164 122.68164 -44.367188 122.75781 -44.191406 curveto +122.833984 -44.015625 122.87207 -43.67871 122.87207 -43.180664 curveto +122.87207 -35.868164 lineto +122.87207 -34.95996 122.85156 -34.401855 122.81055 -34.193848 curveto +122.76953 -33.98584 122.70361 -33.84375 122.61279 -33.76758 curveto +122.52197 -33.691406 122.40625 -33.65332 122.265625 -33.65332 curveto +122.11328 -33.65332 121.91992 -33.700195 121.68555 -33.793945 curveto +121.53613 -33.48633 lineto +123.93555 -32.501953 lineto +closepath +fill +newpath +0.0 0.0 0.0 setrgbcolor +grestore +showpage + +%%EOF \ No newline at end of file diff --git a/books/ps/v5mkObjWrap.eps b/books/ps/v5mkObjWrap.eps new file mode 100644 index 0000000..9e5c566 --- /dev/null +++ b/books/ps/v5mkObjWrap.eps @@ -0,0 +1,639 @@ +%!PS-Adobe-3.0 EPSF-3.0 +%%Creator: jlibeps 0.1, https://sourceforge.net/projects/jlibeps/ +%%Title: LaTeXDraw +%%CreationDate: Wed Nov 12 19:09:52 EST 2014 +%%BoundingBox: 0 0 199 109 +%%DocumentData: Clean7Bit +%%DocumentProcessColors: Black +%%ColorUsage: Color +%%Origin: 0 0 +%%Pages: 1 +%%Page: 1 1 +%%EndComments + +gsave +-34.0 124.0 translate +2.0 setlinewidth +10.0 setmiterlimit +0 setlinejoin +0 setlinecap +[ ] 0 setdash +0.0 0.0 0.0 setrgbcolor +0.0 0.0 0.0 setrgbcolor +newpath +40.0 -21.0 moveto +139.0 -21.0 lineto +139.0 -58.0 lineto +40.0 -58.0 lineto +40.0 -21.0 lineto +closepath +stroke +newpath +0.0 0.0 0.0 setrgbcolor +0.0 0.0 0.0 setrgbcolor +2.0 setlinewidth +10.0 setmiterlimit +0 setlinejoin +0 setlinecap +[ ] 0 setdash +0.0 0.0 0.0 setrgbcolor +newpath +90.0 -23.0 moveto +90.0 -59.0 lineto +stroke +newpath +2.0 setlinewidth +10.0 setmiterlimit +0 setlinejoin +0 setlinecap +[ ] 0 setdash +0.0 0.0 0.0 setrgbcolor +0.0 0.0 0.0 setrgbcolor +newpath +47.953125 -37.42578 moveto +48.539062 -36.839844 48.884766 -36.50293 48.990234 -36.41504 curveto +49.253906 -36.192383 49.538086 -36.01953 49.842773 -35.896484 curveto +50.14746 -35.773438 50.44922 -35.711914 50.748047 -35.711914 curveto +51.251953 -35.711914 51.685547 -35.8584 52.04883 -36.151367 curveto +52.41211 -36.444336 52.655273 -36.86914 52.77832 -37.42578 curveto +53.381836 -36.722656 53.8916 -36.26123 54.307617 -36.041504 curveto +54.723633 -35.821777 55.151367 -35.711914 55.59082 -35.711914 curveto +56.018555 -35.711914 56.39795 -35.821777 56.729004 -36.041504 curveto +57.06006 -36.26123 57.322266 -36.620117 57.515625 -37.118164 curveto +57.64453 -37.458008 57.708984 -37.99121 57.708984 -38.717773 curveto +57.708984 -42.180664 lineto +57.708984 -42.68457 57.74707 -43.030273 57.823242 -43.217773 curveto +57.881836 -43.34668 57.990234 -43.456543 58.148438 -43.547363 curveto +58.30664 -43.638184 58.564453 -43.683594 58.921875 -43.683594 curveto +58.921875 -44.0 lineto +54.94922 -44.0 lineto +54.94922 -43.683594 lineto +55.11621 -43.683594 lineto +55.461914 -43.683594 55.731445 -43.61621 55.924805 -43.481445 curveto +56.05957 -43.387695 56.15625 -43.23828 56.214844 -43.033203 curveto +56.23828 -42.933594 56.25 -42.649414 56.25 -42.180664 curveto +56.25 -38.717773 lineto +56.25 -38.061523 56.1709 -37.598633 56.012695 -37.3291 curveto +55.78418 -36.9541 55.41797 -36.7666 54.914062 -36.7666 curveto +54.603516 -36.7666 54.291504 -36.84424 53.978027 -36.99951 curveto +53.66455 -37.154785 53.285156 -37.44336 52.839844 -37.865234 curveto +52.822266 -37.961914 lineto +52.839844 -38.339844 lineto +52.839844 -42.180664 lineto +52.839844 -42.731445 52.870605 -43.07422 52.93213 -43.208984 curveto +52.993652 -43.34375 53.109375 -43.456543 53.279297 -43.547363 curveto +53.44922 -43.638184 53.739258 -43.683594 54.149414 -43.683594 curveto +54.149414 -44.0 lineto +50.08008 -44.0 lineto +50.08008 -43.683594 lineto +50.52539 -43.683594 50.831543 -43.63086 50.998535 -43.52539 curveto +51.165527 -43.41992 51.28125 -43.26172 51.345703 -43.05078 curveto +51.375 -42.95117 51.38965 -42.661133 51.38965 -42.180664 curveto +51.38965 -38.717773 lineto +51.38965 -38.061523 51.29297 -37.589844 51.09961 -37.302734 curveto +50.841797 -36.927734 50.481445 -36.740234 50.018555 -36.740234 curveto +49.70215 -36.740234 49.38867 -36.825195 49.078125 -36.995117 curveto +48.591797 -37.25293 48.216797 -37.54297 47.953125 -37.865234 curveto +47.953125 -42.180664 lineto +47.953125 -42.708008 47.989746 -43.05078 48.06299 -43.208984 curveto +48.13623 -43.367188 48.24463 -43.48584 48.388184 -43.56494 curveto +48.53174 -43.644043 48.823242 -43.683594 49.262695 -43.683594 curveto +49.262695 -44.0 lineto +45.28125 -44.0 lineto +45.28125 -43.683594 lineto +45.65039 -43.683594 45.908203 -43.644043 46.054688 -43.56494 curveto +46.20117 -43.48584 46.3125 -43.359863 46.38867 -43.18701 curveto +46.464844 -43.01416 46.50293 -42.67871 46.50293 -42.180664 curveto +46.50293 -39.104492 lineto +46.50293 -38.219727 46.476562 -37.648438 46.42383 -37.390625 curveto +46.382812 -37.197266 46.31836 -37.063965 46.23047 -36.990723 curveto +46.14258 -36.91748 46.02246 -36.88086 45.870117 -36.88086 curveto +45.706055 -36.88086 45.509766 -36.924805 45.28125 -37.012695 curveto +45.149414 -36.69629 lineto +47.575195 -35.711914 lineto +47.953125 -35.711914 lineto +closepath +63.5 -35.711914 moveto +64.71875 -35.711914 65.697266 -36.174805 66.43555 -37.100586 curveto +67.0625 -37.8916 67.37598 -38.799805 67.37598 -39.825195 curveto +67.37598 -40.5459 67.203125 -41.27539 66.85742 -42.01367 curveto +66.51172 -42.751953 66.035645 -43.308594 65.4292 -43.683594 curveto +64.822754 -44.058594 64.14746 -44.246094 63.40332 -44.246094 curveto +62.19043 -44.246094 61.226562 -43.762695 60.51172 -42.7959 curveto +59.908203 -41.981445 59.606445 -41.067383 59.606445 -40.05371 curveto +59.606445 -39.31543 59.78955 -38.581543 60.15576 -37.85205 curveto +60.521973 -37.12256 61.003906 -36.583496 61.601562 -36.234863 curveto +62.19922 -35.88623 62.83203 -35.711914 63.5 -35.711914 curveto +closepath +63.22754 -36.283203 moveto +62.916992 -36.283203 62.60498 -36.37549 62.291504 -36.56006 curveto +61.978027 -36.74463 61.72461 -37.06836 61.53125 -37.53125 curveto +61.33789 -37.99414 61.24121 -38.588867 61.24121 -39.31543 curveto +61.24121 -40.487305 61.47412 -41.498047 61.93994 -42.347656 curveto +62.40576 -43.197266 63.01953 -43.62207 63.78125 -43.62207 curveto +64.34961 -43.62207 64.81836 -43.387695 65.1875 -42.918945 curveto +65.55664 -42.450195 65.74121 -41.64453 65.74121 -40.501953 curveto +65.74121 -39.072266 65.43359 -37.947266 64.81836 -37.126953 curveto +64.40234 -36.564453 63.87207 -36.283203 63.22754 -36.283203 curveto +closepath +74.24902 -43.094727 moveto +73.856445 -43.504883 73.47266 -43.799316 73.09766 -43.978027 curveto +72.72266 -44.15674 72.31836 -44.246094 71.884766 -44.246094 curveto +71.00586 -44.246094 70.23828 -43.878418 69.58203 -43.143066 curveto +68.92578 -42.407715 68.59766 -41.46289 68.59766 -40.308594 curveto +68.59766 -39.154297 68.96094 -38.098145 69.6875 -37.140137 curveto +70.41406 -36.18213 71.34863 -35.703125 72.49121 -35.703125 curveto +73.200195 -35.703125 73.78613 -35.92871 74.24902 -36.379883 curveto +74.24902 -34.89453 lineto +74.24902 -33.97461 74.22705 -33.40918 74.183105 -33.198242 curveto +74.13916 -32.987305 74.07031 -32.84375 73.97656 -32.76758 curveto +73.88281 -32.691406 73.765625 -32.65332 73.625 -32.65332 curveto +73.47266 -32.65332 73.27051 -32.700195 73.018555 -32.793945 curveto +72.9043 -32.48633 lineto +75.30371 -31.501953 lineto +75.69922 -31.501953 lineto +75.69922 -40.80957 lineto +75.69922 -41.75293 75.72119 -42.328613 75.76514 -42.53662 curveto +75.80908 -42.74463 75.879395 -42.88965 75.976074 -42.97168 curveto +76.072754 -43.05371 76.18555 -43.094727 76.31445 -43.094727 curveto +76.47266 -43.094727 76.68359 -43.04492 76.947266 -42.945312 curveto +77.043945 -43.25293 lineto +74.65332 -44.246094 lineto +74.24902 -44.246094 lineto +closepath +74.24902 -42.479492 moveto +74.24902 -38.331055 lineto +74.21387 -37.932617 74.1084 -37.569336 73.93262 -37.24121 curveto +73.756836 -36.913086 73.523926 -36.665527 73.23389 -36.498535 curveto +72.94385 -36.331543 72.66113 -36.248047 72.38574 -36.248047 curveto +71.87012 -36.248047 71.41016 -36.479492 71.00586 -36.942383 curveto +70.47266 -37.551758 70.206055 -38.442383 70.206055 -39.614258 curveto +70.206055 -40.79785 70.46387 -41.70459 70.97949 -42.334473 curveto +71.49512 -42.964355 72.069336 -43.279297 72.70215 -43.279297 curveto +73.23535 -43.279297 73.75098 -43.012695 74.24902 -42.479492 curveto +closepath +78.916016 -38.981445 moveto +78.91016 -40.176758 79.200195 -41.114258 79.78613 -41.793945 curveto +80.37207 -42.473633 81.06055 -42.813477 81.85156 -42.813477 curveto +82.37891 -42.813477 82.8374 -42.668457 83.22705 -42.378418 curveto +83.6167 -42.08838 83.94336 -41.591797 84.20703 -40.88867 curveto +84.47949 -41.064453 lineto +84.356445 -41.867188 83.99902 -42.598145 83.40723 -43.257324 curveto +82.81543 -43.916504 82.07422 -44.246094 81.18359 -44.246094 curveto +80.2168 -44.246094 79.38916 -43.86963 78.70068 -43.1167 curveto +78.01221 -42.36377 77.66797 -41.351562 77.66797 -40.08008 curveto +77.66797 -38.703125 78.020996 -37.629395 78.72705 -36.858887 curveto +79.433105 -36.08838 80.319336 -35.703125 81.38574 -35.703125 curveto +82.288086 -35.703125 83.0293 -36.00049 83.609375 -36.595215 curveto +84.18945 -37.18994 84.47949 -37.98535 84.47949 -38.981445 curveto +closepath +78.916016 -38.47168 moveto +82.64258 -38.47168 lineto +82.61328 -37.956055 82.55176 -37.592773 82.45801 -37.381836 curveto +82.31152 -37.05371 82.09326 -36.7959 81.80322 -36.6084 curveto +81.51318 -36.4209 81.20996 -36.32715 80.893555 -36.32715 curveto +80.40723 -36.32715 79.97217 -36.516113 79.58838 -36.894043 curveto +79.20459 -37.271973 78.98047 -37.79785 78.916016 -38.47168 curveto +closepath +fill +newpath +0.0 0.0 0.0 setrgbcolor +2.0 setlinewidth +10.0 setmiterlimit +0 setlinejoin +0 setlinecap +[ ] 0 setdash +0.0 0.0 0.0 setrgbcolor +0.0 0.0 0.0 setrgbcolor +newpath +88.0 -79.0 moveto +227.0 -79.0 lineto +227.0 -118.0 lineto +88.0 -118.0 lineto +88.0 -79.0 lineto +closepath +stroke +newpath +0.0 0.0 0.0 setrgbcolor +0.0 0.0 0.0 setrgbcolor +2.0 setlinewidth +10.0 setmiterlimit +0 setlinejoin +0 setlinecap +[ ] 0 setdash +0.0 0.0 0.0 setrgbcolor +newpath +181.0 -81.0 moveto +181.0 -117.0 lineto +stroke +newpath +2.0 setlinewidth +10.0 setmiterlimit +0 setlinejoin +0 setlinecap +[ ] 0 setdash +0.0 0.0 0.0 setrgbcolor +0.0 0.0 0.0 setrgbcolor +newpath +94.234375 -97.72656 moveto +93.8125 -95.41406 lineto +93.69271 -94.77344 93.63281 -94.34115 93.63281 -94.11719 curveto +93.63281 -93.78385 93.70052 -93.541664 93.83594 -93.390625 curveto +93.97135 -93.239586 94.15625 -93.16406 94.390625 -93.16406 curveto +94.625 -93.16406 94.81901 -93.24088 94.97266 -93.39453 curveto +95.126305 -93.54818 95.203125 -93.75 95.203125 -94.0 curveto +95.203125 -94.19271 95.135414 -94.666664 95.0 -95.421875 curveto +94.578125 -97.72656 lineto +closepath +110.97656 -93.40625 moveto +110.97656 -93.69531 lineto +110.70052 -93.69531 110.47656 -93.74479 110.30469 -93.84375 curveto +110.13281 -93.94271 109.96875 -94.1276 109.8125 -94.39844 curveto +109.708336 -94.58073 109.54427 -95.015625 109.32031 -95.703125 curveto +106.36719 -104.24219 lineto +106.05469 -104.24219 lineto +103.640625 -97.46875 lineto +101.24219 -104.24219 lineto +100.96094 -104.24219 lineto +97.8125 -95.44531 lineto +97.578125 -94.78906 97.42969 -94.40104 97.36719 -94.28125 curveto +97.26302 -94.083336 97.12109 -93.936195 96.94141 -93.83984 curveto +96.76172 -93.74349 96.51823 -93.69531 96.21094 -93.69531 curveto +96.21094 -93.40625 lineto +100.13281 -93.40625 lineto +100.13281 -93.69531 lineto +99.94531 -93.69531 lineto +99.66927 -93.69531 99.458336 -93.75781 99.3125 -93.88281 curveto +99.166664 -94.00781 99.09375 -94.15885 99.09375 -94.33594 curveto +99.09375 -94.51823 99.208336 -94.9375 99.4375 -95.59375 curveto +101.52344 -101.53906 lineto +103.28125 -96.484375 lineto +102.96875 -95.59375 lineto +102.71875 -94.88281 lineto +102.609375 -94.6224 102.48698 -94.39323 102.35156 -94.19531 curveto +102.28385 -94.09635 102.20052 -94.01302 102.10156 -93.94531 curveto +101.97135 -93.85156 101.84115 -93.78385 101.71094 -93.74219 curveto +101.61198 -93.71094 101.45573 -93.69531 101.24219 -93.69531 curveto +101.24219 -93.40625 lineto +105.36719 -93.40625 lineto +105.36719 -93.69531 lineto +105.08594 -93.69531 lineto +104.79427 -93.69531 104.58073 -93.75781 104.44531 -93.88281 curveto +104.3099 -94.00781 104.24219 -94.177086 104.24219 -94.390625 curveto +104.24219 -94.65625 104.359375 -95.11979 104.59375 -95.78125 curveto +106.625 -101.53906 lineto +108.640625 -95.703125 lineto +108.86979 -95.05729 108.984375 -94.609375 108.984375 -94.359375 curveto +108.984375 -94.239586 108.94662 -94.1276 108.87109 -94.02344 curveto +108.79557 -93.91927 108.70052 -93.84635 108.58594 -93.80469 curveto +108.38802 -93.73177 108.13021 -93.69531 107.8125 -93.69531 curveto +107.8125 -93.40625 lineto +closepath +121.8125 -104.0 moveto +118.984375 -104.0 lineto +115.39844 -99.046875 lineto +115.13281 -99.05729 114.916664 -99.0625 114.75 -99.0625 curveto +114.68229 -99.0625 114.609375 -99.061195 114.53125 -99.05859 curveto +114.453125 -99.05599 114.3724 -99.052086 114.28906 -99.046875 curveto +114.28906 -102.125 lineto +114.28906 -102.791664 114.36198 -103.20573 114.50781 -103.36719 curveto +114.70573 -103.59635 115.0026 -103.71094 115.39844 -103.71094 curveto +115.8125 -103.71094 lineto +115.8125 -104.0 lineto +111.27344 -104.0 lineto +111.27344 -103.71094 lineto +111.671875 -103.71094 lineto +112.11979 -103.71094 112.4401 -103.5651 112.63281 -103.27344 curveto +112.74219 -103.11198 112.796875 -102.729164 112.796875 -102.125 curveto +112.796875 -95.28125 lineto +112.796875 -94.614586 112.72396 -94.20052 112.578125 -94.03906 curveto +112.375 -93.8099 112.072914 -93.69531 111.671875 -93.69531 curveto +111.27344 -93.69531 lineto +111.27344 -93.40625 lineto +115.13281 -93.40625 lineto +116.25781 -93.40625 117.08724 -93.48828 117.62109 -93.65234 curveto +118.154945 -93.81641 118.60807 -94.11849 118.98047 -94.55859 curveto +119.35287 -94.998695 119.53906 -95.52344 119.53906 -96.13281 curveto +119.53906 -96.78385 119.32682 -97.34896 118.90234 -97.828125 curveto +118.47787 -98.30729 117.82031 -98.645836 116.92969 -98.84375 curveto +119.11719 -101.88281 lineto +119.61719 -102.58073 120.046875 -103.04427 120.40625 -103.27344 curveto +120.765625 -103.5026 121.234375 -103.64844 121.8125 -103.71094 curveto +closepath +114.28906 -98.55469 moveto +114.38802 -98.55469 114.47396 -98.55599 114.546875 -98.55859 curveto +114.61979 -98.561195 114.67969 -98.5625 114.72656 -98.5625 curveto +115.73698 -98.5625 116.498695 -98.34375 117.01172 -97.90625 curveto +117.52474 -97.46875 117.78125 -96.91146 117.78125 -96.234375 curveto +117.78125 -95.572914 117.57422 -95.03516 117.16016 -94.62109 curveto +116.74609 -94.20703 116.197914 -94.0 115.515625 -94.0 curveto +115.21354 -94.0 114.80469 -94.04948 114.28906 -94.14844 curveto +closepath +129.32031 -100.453125 moveto +125.21875 -100.453125 lineto +124.5 -102.125 lineto +124.322914 -102.53646 124.234375 -102.84375 124.234375 -103.046875 curveto +124.234375 -103.208336 124.311195 -103.35026 124.46484 -103.47266 curveto +124.61849 -103.595055 124.95052 -103.67448 125.46094 -103.71094 curveto +125.46094 -104.0 lineto +122.125 -104.0 lineto +122.125 -103.71094 lineto +122.56771 -103.63281 122.854164 -103.53125 122.984375 -103.40625 curveto +123.25 -103.15625 123.54427 -102.64844 123.86719 -101.88281 curveto +127.59375 -93.16406 lineto +127.86719 -93.16406 lineto +131.55469 -101.97656 lineto +131.85156 -102.6849 132.1211 -103.14453 132.36328 -103.35547 curveto +132.60547 -103.56641 132.9427 -103.6849 133.375 -103.71094 curveto +133.375 -104.0 lineto +129.19531 -104.0 lineto +129.19531 -103.71094 lineto +129.61719 -103.6901 129.90234 -103.61979 130.05078 -103.5 curveto +130.19922 -103.38021 130.27344 -103.234375 130.27344 -103.0625 curveto +130.27344 -102.833336 130.16927 -102.47135 129.96094 -101.97656 curveto +closepath +129.10156 -99.875 moveto +127.30469 -95.59375 lineto +125.46094 -99.875 lineto +closepath +137.28125 -99.03906 moveto +137.28125 -102.125 lineto +137.28125 -102.791664 137.35417 -103.20573 137.5 -103.36719 curveto +137.69792 -103.59635 137.99739 -103.71094 138.39844 -103.71094 curveto +138.80469 -103.71094 lineto +138.80469 -104.0 lineto +134.26562 -104.0 lineto +134.26562 -103.71094 lineto +134.66406 -103.71094 lineto +135.11198 -103.71094 135.4323 -103.5651 135.625 -103.27344 curveto +135.72917 -103.11198 135.78125 -102.729164 135.78125 -102.125 curveto +135.78125 -95.28125 lineto +135.78125 -94.614586 135.71094 -94.20052 135.57031 -94.03906 curveto +135.36719 -93.8099 135.06511 -93.69531 134.66406 -93.69531 curveto +134.26562 -93.69531 lineto +134.26562 -93.40625 lineto +138.14844 -93.40625 lineto +139.09636 -93.40625 139.84375 -93.50391 140.39062 -93.69922 curveto +140.9375 -93.89453 141.39844 -94.22396 141.77344 -94.6875 curveto +142.14844 -95.15104 142.33594 -95.70052 142.33594 -96.33594 curveto +142.33594 -97.20052 142.05078 -97.90365 141.48047 -98.44531 curveto +140.91016 -98.98698 140.10417 -99.25781 139.0625 -99.25781 curveto +138.8073 -99.25781 138.53125 -99.239586 138.23438 -99.203125 curveto +137.9375 -99.166664 137.6198 -99.11198 137.28125 -99.03906 curveto +closepath +137.28125 -98.59375 moveto +137.5573 -98.645836 137.80208 -98.6849 138.01562 -98.71094 curveto +138.22917 -98.73698 138.41145 -98.75 138.5625 -98.75 curveto +139.10417 -98.75 139.57161 -98.54037 139.96484 -98.12109 curveto +140.35808 -97.70182 140.55469 -97.15885 140.55469 -96.49219 curveto +140.55469 -96.03385 140.46094 -95.60807 140.27344 -95.21484 curveto +140.08594 -94.82162 139.82031 -94.52734 139.47656 -94.33203 curveto +139.13281 -94.13672 138.74219 -94.03906 138.30469 -94.03906 curveto +138.03906 -94.03906 137.69792 -94.08854 137.28125 -94.1875 curveto +closepath +146.28125 -99.03906 moveto +146.28125 -102.125 lineto +146.28125 -102.791664 146.35417 -103.20573 146.5 -103.36719 curveto +146.69792 -103.59635 146.99739 -103.71094 147.39844 -103.71094 curveto +147.80469 -103.71094 lineto +147.80469 -104.0 lineto +143.26562 -104.0 lineto +143.26562 -103.71094 lineto +143.66406 -103.71094 lineto +144.11198 -103.71094 144.4323 -103.5651 144.625 -103.27344 curveto +144.72917 -103.11198 144.78125 -102.729164 144.78125 -102.125 curveto +144.78125 -95.28125 lineto +144.78125 -94.614586 144.71094 -94.20052 144.57031 -94.03906 curveto +144.36719 -93.8099 144.06511 -93.69531 143.66406 -93.69531 curveto +143.26562 -93.69531 lineto +143.26562 -93.40625 lineto +147.14844 -93.40625 lineto +148.09636 -93.40625 148.84375 -93.50391 149.39062 -93.69922 curveto +149.9375 -93.89453 150.39844 -94.22396 150.77344 -94.6875 curveto +151.14844 -95.15104 151.33594 -95.70052 151.33594 -96.33594 curveto +151.33594 -97.20052 151.05078 -97.90365 150.48047 -98.44531 curveto +149.91016 -98.98698 149.10417 -99.25781 148.0625 -99.25781 curveto +147.8073 -99.25781 147.53125 -99.239586 147.23438 -99.203125 curveto +146.9375 -99.166664 146.6198 -99.11198 146.28125 -99.03906 curveto +closepath +146.28125 -98.59375 moveto +146.5573 -98.645836 146.80208 -98.6849 147.01562 -98.71094 curveto +147.22917 -98.73698 147.41145 -98.75 147.5625 -98.75 curveto +148.10417 -98.75 148.57161 -98.54037 148.96484 -98.12109 curveto +149.35808 -97.70182 149.55469 -97.15885 149.55469 -96.49219 curveto +149.55469 -96.03385 149.46094 -95.60807 149.27344 -95.21484 curveto +149.08594 -94.82162 148.82031 -94.52734 148.47656 -94.33203 curveto +148.13281 -94.13672 147.74219 -94.03906 147.30469 -94.03906 curveto +147.03906 -94.03906 146.69792 -94.08854 146.28125 -94.1875 curveto +closepath +155.34375 -93.984375 moveto +155.34375 -98.171875 lineto +157.67188 -98.171875 lineto +158.27605 -98.171875 158.67969 -98.08073 158.88281 -97.89844 curveto +159.15364 -97.65885 159.30469 -97.23698 159.33594 -96.63281 curveto +159.625 -96.63281 lineto +159.625 -100.32031 lineto +159.33594 -100.32031 lineto +159.26302 -99.80469 159.19011 -99.47396 159.11719 -99.328125 curveto +159.02344 -99.145836 158.8698 -99.0026 158.65625 -98.89844 curveto +158.4427 -98.79427 158.11458 -98.74219 157.67188 -98.74219 curveto +155.34375 -98.74219 lineto +155.34375 -102.234375 lineto +155.34375 -102.703125 155.36458 -102.98828 155.40625 -103.08984 curveto +155.44792 -103.19141 155.52083 -103.27213 155.625 -103.33203 curveto +155.72917 -103.39193 155.92708 -103.421875 156.21875 -103.421875 curveto +158.01562 -103.421875 lineto +158.61458 -103.421875 159.04948 -103.38021 159.32031 -103.296875 curveto +159.59114 -103.21354 159.85156 -103.04948 160.10156 -102.80469 curveto +160.42448 -102.48177 160.7552 -101.99479 161.09375 -101.34375 curveto +161.40625 -101.34375 lineto +160.49219 -104.0 lineto +152.32812 -104.0 lineto +152.32812 -103.71094 lineto +152.70312 -103.71094 lineto +152.95312 -103.71094 153.19011 -103.65104 153.41406 -103.53125 curveto +153.58073 -103.447914 153.69402 -103.322914 153.7539 -103.15625 curveto +153.8138 -102.989586 153.84375 -102.64844 153.84375 -102.13281 curveto +153.84375 -95.25 lineto +153.84375 -94.578125 153.77605 -94.16406 153.64062 -94.00781 curveto +153.45312 -93.79948 153.14062 -93.69531 152.70312 -93.69531 curveto +152.32812 -93.69531 lineto +152.32812 -93.40625 lineto +160.49219 -93.40625 lineto +160.60938 -95.72656 lineto +160.30469 -95.72656 lineto +160.19531 -95.16927 160.07422 -94.78646 159.9414 -94.578125 curveto +159.8086 -94.36979 159.61198 -94.21094 159.35156 -94.10156 curveto +159.14323 -94.02344 158.77605 -93.984375 158.25 -93.984375 curveto +closepath +162.27344 -104.0 moveto +162.27344 -103.71094 lineto +162.67188 -103.71094 lineto +163.1198 -103.71094 163.4375 -103.56771 163.625 -103.28125 curveto +163.73958 -103.109375 163.79688 -102.72396 163.79688 -102.125 curveto +163.79688 -95.28125 lineto +163.79688 -94.61979 163.72395 -94.20573 163.57812 -94.03906 curveto +163.375 -93.8099 163.07292 -93.69531 162.67188 -93.69531 curveto +162.27344 -93.69531 lineto +162.27344 -93.40625 lineto +166.58594 -93.40625 lineto +168.16927 -93.40625 169.3737 -93.58594 170.19922 -93.94531 curveto +171.02473 -94.30469 171.6888 -94.90365 172.1914 -95.74219 curveto +172.69402 -96.58073 172.94531 -97.54948 172.94531 -98.64844 curveto +172.94531 -100.1224 172.49739 -101.354164 171.60156 -102.34375 curveto +170.59636 -103.447914 169.06511 -104.0 167.00781 -104.0 curveto +closepath +165.29688 -103.234375 moveto +165.95833 -103.38021 166.51302 -103.453125 166.96094 -103.453125 curveto +168.16927 -103.453125 169.17188 -103.02865 169.96875 -102.17969 curveto +170.76562 -101.33073 171.16406 -100.17969 171.16406 -98.72656 curveto +171.16406 -97.26302 170.76562 -96.109375 169.96875 -95.265625 curveto +169.17188 -94.421875 168.14844 -94.0 166.89844 -94.0 curveto +166.42969 -94.0 165.89583 -94.07552 165.29688 -94.22656 curveto +closepath +fill +newpath +0.0 0.0 0.0 setrgbcolor +0.0 0.0 0.0 setrgbcolor +newpath +191.14941 -95.94922 moveto +194.9375 -95.94922 lineto +194.9375 -96.274414 lineto +194.6914 -96.274414 lineto +194.46289 -96.274414 194.28857 -96.33008 194.16846 -96.44141 curveto +194.04834 -96.552734 193.98828 -96.70215 193.98828 -96.88965 curveto +193.98828 -97.09473 194.0498 -97.33789 194.17285 -97.61914 curveto +196.04492 -102.06641 lineto +197.92578 -97.45215 lineto +198.06055 -97.12402 198.12793 -96.875 198.12793 -96.70508 curveto +198.12793 -96.62305 198.10449 -96.555664 198.05762 -96.50293 curveto +197.99316 -96.41504 197.91113 -96.35498 197.81152 -96.322754 curveto +197.71191 -96.29053 197.50977 -96.274414 197.20508 -96.274414 curveto +197.20508 -95.94922 lineto +199.83301 -95.94922 lineto +199.83301 -96.274414 lineto +199.52832 -96.29785 199.31738 -96.359375 199.2002 -96.458984 curveto +198.99512 -96.634766 198.81055 -96.927734 198.64648 -97.33789 curveto +195.79004 -104.24609 lineto +195.42969 -104.24609 lineto +192.55566 -97.45215 lineto +192.42676 -97.13574 192.30371 -96.90869 192.18652 -96.770996 curveto +192.06934 -96.6333 191.91992 -96.51758 191.73828 -96.42383 curveto +191.63867 -96.37109 191.44238 -96.32129 191.14941 -96.274414 curveto +closepath +205.12402 -102.83984 moveto +204.29785 -103.478516 203.7793 -103.84766 203.56836 -103.947266 curveto +203.25195 -104.09375 202.91504 -104.16699 202.55762 -104.16699 curveto +202.00098 -104.16699 201.54248 -103.97656 201.18213 -103.5957 curveto +200.82178 -103.21484 200.6416 -102.71387 200.6416 -102.09277 curveto +200.6416 -101.700195 200.72949 -101.36035 200.90527 -101.07324 curveto +201.14551 -100.674805 201.56299 -100.299805 202.15771 -99.94824 curveto +202.75244 -99.59668 203.74121 -99.168945 205.12402 -98.66504 curveto +205.12402 -98.34863 lineto +205.12402 -97.5459 204.99658 -96.99512 204.7417 -96.69629 curveto +204.48682 -96.39746 204.11621 -96.24805 203.62988 -96.24805 curveto +203.26074 -96.24805 202.96777 -96.34766 202.75098 -96.546875 curveto +202.52832 -96.74609 202.41699 -96.97461 202.41699 -97.23242 curveto +202.43457 -97.74219 lineto +202.43457 -98.01172 202.36572 -98.21973 202.22803 -98.36621 curveto +202.09033 -98.512695 201.91016 -98.58594 201.6875 -98.58594 curveto +201.4707 -98.58594 201.29346 -98.509766 201.15576 -98.35742 curveto +201.01807 -98.20508 200.94922 -97.99707 200.94922 -97.7334 curveto +200.94922 -97.22949 201.20703 -96.7666 201.72266 -96.34473 curveto +202.23828 -95.92285 202.96191 -95.711914 203.89355 -95.711914 curveto +204.6084 -95.711914 205.19434 -95.83203 205.65137 -96.072266 curveto +205.99707 -96.25391 206.25195 -96.538086 206.41602 -96.924805 curveto +206.52148 -97.17676 206.57422 -97.69238 206.57422 -98.47168 curveto +206.57422 -101.20508 lineto +206.57422 -101.97266 206.58887 -102.44287 206.61816 -102.61572 curveto +206.64746 -102.788574 206.6958 -102.9043 206.76318 -102.96289 curveto +206.83057 -103.021484 206.9082 -103.05078 206.9961 -103.05078 curveto +207.08984 -103.05078 207.17188 -103.03027 207.24219 -102.98926 curveto +207.36523 -102.913086 207.60254 -102.69922 207.9541 -102.34766 curveto +207.9541 -102.83984 lineto +207.29785 -103.71875 206.6709 -104.1582 206.07324 -104.1582 curveto +205.78613 -104.1582 205.55762 -104.05859 205.3877 -103.859375 curveto +205.21777 -103.66016 205.12988 -103.32031 205.12402 -102.83984 curveto +closepath +205.12402 -102.268555 moveto +205.12402 -99.20117 lineto +204.23926 -99.552734 203.66797 -99.80176 203.41016 -99.94824 curveto +202.94727 -100.206055 202.61621 -100.475586 202.41699 -100.756836 curveto +202.21777 -101.038086 202.11816 -101.3457 202.11816 -101.67969 curveto +202.11816 -102.10156 202.24414 -102.45166 202.4961 -102.72998 curveto +202.74805 -103.0083 203.03809 -103.14746 203.36621 -103.14746 curveto +203.81152 -103.14746 204.39746 -102.85449 205.12402 -102.268555 curveto +closepath +211.33105 -91.50195 moveto +211.33105 -102.180664 lineto +211.33105 -102.68457 211.36768 -103.018555 211.44092 -103.18262 curveto +211.51416 -103.34668 211.62695 -103.47119 211.7793 -103.55615 curveto +211.93164 -103.64111 212.21582 -103.68359 212.63184 -103.68359 curveto +212.63184 -104.0 lineto +208.68555 -104.0 lineto +208.68555 -103.68359 lineto +209.05469 -103.68359 209.30664 -103.64551 209.4414 -103.569336 curveto +209.57617 -103.493164 209.68164 -103.36719 209.75781 -103.19141 curveto +209.83398 -103.015625 209.87207 -102.67871 209.87207 -102.180664 curveto +209.87207 -94.868164 lineto +209.87207 -93.95996 209.85156 -93.401855 209.81055 -93.19385 curveto +209.76953 -92.98584 209.70361 -92.84375 209.6128 -92.76758 curveto +209.52197 -92.69141 209.40625 -92.65332 209.26562 -92.65332 curveto +209.11328 -92.65332 208.91992 -92.700195 208.68555 -92.793945 curveto +208.53613 -92.48633 lineto +210.93555 -91.50195 lineto +closepath +fill +newpath +0.0 0.0 0.0 setrgbcolor +0.0 0.0 0.0 setrgbcolor +2.0 setlinewidth +10.0 setmiterlimit +0 setlinejoin +0 setlinecap +[ ] 0 setdash +0.0 0.0 0.0 setrgbcolor +newpath +115.0 -41.0 moveto +115.0 -76.87708 lineto +stroke +newpath +2.0 setlinewidth +10.0 setmiterlimit +0 setlinejoin +0 setlinecap +[ ] 0 setdash +2.0 setlinewidth +10.0 setmiterlimit +0 setlinejoin +0 setlinecap +[ ] 0 setdash +2.0 setlinewidth +10.0 setmiterlimit +0 setlinejoin +0 setlinecap +[ ] 0 setdash +0.0 0.0 0.0 setrgbcolor +newpath +115.0 -81.0 moveto +111.0 -72.0 lineto +115.0 -76.0 lineto +118.0 -72.0 lineto +closepath +fill +newpath +2.0 setlinewidth +10.0 setmiterlimit +0 setlinejoin +0 setlinecap +[ ] 0 setdash +2.0 setlinewidth +10.0 setmiterlimit +0 setlinejoin +0 setlinecap +[ ] 0 setdash +0.0 0.0 0.0 setrgbcolor +grestore +showpage + +%%EOF \ No newline at end of file diff --git a/changelog b/changelog index a0e098f..a58dede 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,25 @@ +20141113 tpd src/axiom-website/patches.html 20141113.01.tpd.patch +20141113 tpd books/bookvol5 inline object structures using macros +20141113 tpd src/interp/interp-proclaims.lisp remove object structures +20141113 tpd src/interp/slam.lispinline object structures +20141113 tpd src/interp/msgdb.lisp inline object structures +20141113 tpd src/interp/i-spec2.lisp inline object structures +20141113 tpd src/interp/i-spec1.lisp inline object structures +20141113 tpd src/interp/i-output.lisp inline object structures +20141113 tpd src/interp/i-map.lisp inline object structures +20141113 tpd src/interp/i-intern.lisp inline object structures +20141113 tpd src/interp/i-funsel.lisp inline object structures +20141113 tpd src/interp/i-eval.lisp inline object structures +20141113 tpd src/interp/i-coerfn.lisp inline object structures +20141113 tpd src/interp/i-coerce.lisp inline object structures +20141113 tpd src/interp/i-code.lisp inline object structures +20141113 tpd src/interp/i-analy.lisp inline object structures +20141113 tpd src/interp/g-util.lisp inline object structures +20141113 tpd src/interp/format.lisp inline object structures +20141113 tpd src/interp/buildom.lisp inline object structures +20141113 tpd books/bookvol10.3 define functions for interpret in InputForm +20141113 tpd books/ps/v5mkObjWrap.eps display wrapped object structure +20141113 tpd books/ps/v5mkObj.eps display object structure 20141111 tpd src/axiom-website/patches.html 20141111.01.tpd.patch 20141111 tpd books/bookvol5 make obj fns into macros for performance 20141111 tpd src/interp/i-intern.lisp merge obj handling functions diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 5ecf7aa..b521729 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -4698,6 +4698,8 @@ books/Makefile move SPADEDIT and make it executable
books/bookvol5 fix remake handling of source files
20141111.01.tpd.patch books/bookvol5 make obj fns into macros for performance
+20141113.01.tpd.patch +books/bookvol5 inline object structures using macros
diff --git a/src/interp/buildom.lisp.pamphlet b/src/interp/buildom.lisp.pamphlet index b65e47b..89d024a 100644 --- a/src/interp/buildom.lisp.pamphlet +++ b/src/interp/buildom.lisp.pamphlet @@ -212,7 +212,7 @@ (DEFUN |coerceVal2E| (|x| |m|) (declare (special |$Expression|)) (|objValUnwrap| - (|coerceByFunction| (|objNewWrap| |x| |m|) |$Expression|))) + (|coerceByFunction| (mkObjWrap |x| |m|) |$Expression|))) ;findEqualFun(dom) == ; compiledLookup('_=,[$Boolean,'$,'$],dom) diff --git a/src/interp/format.lisp.pamphlet b/src/interp/format.lisp.pamphlet index a16c391..3ed3b6a 100644 --- a/src/interp/format.lisp.pamphlet +++ b/src/interp/format.lisp.pamphlet @@ -1805,7 +1805,7 @@ code which fixes bug 7217 bad title generated in Axiom 3D output. ((AND (|isValidType| |m|) (CONSP |m|) (EQ (GETDATABASE (CAR |m|) 'CONSTRUCTORKIND) '|domain|)) (COND - ((SETQ |x'| (|coerceInteractive| (|objNewWrap| |x| |m|) |$OutputForm|)) + ((SETQ |x'| (|coerceInteractive| (mkObjWrap |x| |m|) |$OutputForm|)) (|form2String1| (|objValUnwrap| |x'|))) (#1='T (|form2String1| |x|)))) (#1# (|form2String1| |x|)))))) diff --git a/src/interp/g-util.lisp.pamphlet b/src/interp/g-util.lisp.pamphlet index 7b4fe16..22ad63d 100644 --- a/src/interp/g-util.lisp.pamphlet +++ b/src/interp/g-util.lisp.pamphlet @@ -953,7 +953,7 @@ (PROGN (SPADLET |outf| (|str2Outform| |s|)) (SPADLET |val| - (|coerceInt| (|mkObj| (|wrap| |outf|) '(|OutputForm|)) + (|coerceInt| (mkObj (|wrap| |outf|) '(|OutputForm|)) '(|TexFormat|))) (SPADLET |val| (|objValUnwrap| |val|)) (CAR (ELT |val| 1)))))) diff --git a/src/interp/i-analy.lisp.pamphlet b/src/interp/i-analy.lisp.pamphlet index 32fa7a8..7c4bc80 100644 --- a/src/interp/i-analy.lisp.pamphlet +++ b/src/interp/i-analy.lisp.pamphlet @@ -83,9 +83,9 @@ ((> |x| 0) |$PositiveInteger|) ((EQL |x| 0) |$NonNegativeInteger|) ('T |$Integer|))) - (|objNewWrap| |x| |t|)) - ((STRINGP |x|) (|objNewWrap| |x| |$String|)) - ((FLOATP |x|) (|objNewWrap| |x| |$DoubleFloat|)) + (mkObjWrap |x| |t|)) + ((STRINGP |x|) (mkObjWrap |x| |$String|)) + ((FLOATP |x|) (mkObjWrap |x| |$DoubleFloat|)) ('T NIL))))) ;getMinimalVariableTower(var,t) == @@ -933,7 +933,7 @@ ((|isWrapped| |val|) (SPADLET |val| (|unwrap| |val|)) (SPADLET |bm| (|getBasicMode| |val|)) - (|putValue| |op| (|objNewWrap| |val| |bm|)) + (|putValue| |op| (mkObjWrap |val| |bm|)) (|putModeSet| |op| (CONS |bm| NIL))) ('T |ms|))) ('T |ms|))))))) @@ -1197,20 +1197,20 @@ ((AND |target| (NULL |isSub|) (SPADLET |val| (|coerceInteractive| - (|objNewWrap| |id| + (mkObjWrap |id| (CONS '|Variable| (CONS |id| NIL))) |target|))) (|putValue| |t| |val|) (CONS |target| NIL)) ((AND (NULL |target|) (NULL |isSub|) |m| (SPADLET |val| (|coerceInteractive| - (|objNewWrap| |id| + (mkObjWrap |id| (CONS '|Variable| (CONS |id| NIL))) |m|))) (|putValue| |t| |val|) (CONS |m| NIL)) ('T (|throwKeyedMsg| "S2IB0004" (CONS |id| (CONS |m| NIL)))))))) - ('T (SPADLET |val| (|objNewWrap| |id| |defaultMode|)) + ('T (SPADLET |val| (mkObjWrap |id| |defaultMode|)) (COND ((OR (NULL |target|) (BOOT-EQUAL |defaultMode| |target|)) (|putValue| |t| |val|) (CONS |defaultMode| NIL)) @@ -1239,7 +1239,7 @@ (COND ((SPADLET |val'| (|coerceInteractive| - (|objNewWrap| |id| + (mkObjWrap |id| (CONS '|Variable| (CONS |id| NIL))) |dmode|)) @@ -1320,13 +1320,13 @@ ((NULL (SPADLET |tmode| (|resolveTM| |mdv| |tmode|))) (EXIT (|keyedMsgCompFailure| 'S2IB0010 NIL)))))) - (|putValue| |t| (|objNew| |expr| |tmode|)) + (|putValue| |t| (mkObj |expr| |tmode|)) (CONS |tmode| NIL))) ((OR |tmode| (AND |tval| (SPADLET |tmode| (|objMode| |tval|)))) - (|putValue| |t| (|objNew| |expr| |tmode|)) + (|putValue| |t| (mkObj |expr| |tmode|)) (CONS |tmode| NIL)) - ('T (SPADLET |obj| (|objNew| |expr| |defaultMode|)) + ('T (SPADLET |obj| (mkObj |expr| |defaultMode|)) (COND ((AND (|canCoerceFrom| |defaultMode| |target|) (SPADLET |obj'| @@ -1811,7 +1811,7 @@ (COND (|$genValue| (SPADLET |code| (|wrap| (|timedEVALFUN| |code|))))) - (SPADLET |val| (|objNew| |code| |rtype|)) + (SPADLET |val| (mkObj |code| |rtype|)) (|putValue| |t| |val|) (|putModeSet| |t| (CONS |rtype| NIL))) ('T (SPADLET |m| (|getModeOrFirstModeSetIfThere| |op|)) @@ -2073,7 +2073,7 @@ ((|isPartialMode| |type|) '(|Mode|)) ((|categoryForm?| |type|) '(|Category|)) ('T '(|Domain|)))) - (SPADLET |val| (|objNew| |type| |mode|)) + (SPADLET |val| (mkObj |type| |mode|)) (|putValue| |t| |val|) (|putModeSet| |t| (CONS |mode| NIL)))))) diff --git a/src/interp/i-code.lisp.pamphlet b/src/interp/i-code.lisp.pamphlet index 8f2a86f..4516a47 100755 --- a/src/interp/i-code.lisp.pamphlet +++ b/src/interp/i-code.lisp.pamphlet @@ -120,7 +120,7 @@ (OR (BOOT-EQUAL |t1| |$Void|) (|canCoerceFrom| (|removeQuote| |t0|) |t2|))) (|intCodeGenCOERCE| - (|objNew| |val0| (|removeQuote| |t0|)) |t2|)) + (mkObj |val0| (|removeQuote| |t0|)) |t2|)) ((AND (CONSP |val|) (EQ (QCAR |val|) 'THROW) (PROGN (SPADLET |ISTMP#1| (QCDR |val|)) @@ -147,17 +147,17 @@ (COND ((OR (NULL |$compilingMap|) (NEQUAL |label| (|mapCatchName| |$mapName|))) - (|objNew| + (mkObj (CONS 'THROW (CONS |label| (CONS (|wrapped2Quote| (|objVal| (|intCodeGenCOERCE| - (|objNew| |code| |t1|) |t2|))) + (mkObj |code| |t1|) |t2|))) NIL))) |t2|)) - ('T (|objNew| |val| |t2|)))) + ('T (mkObj |val| |t2|)))) ((AND (CONSP |val|) (EQ (QCAR |val|) 'PROGN) (PROGN (SPADLET |ISTMP#1| (QCDR |val|)) @@ -174,20 +174,20 @@ (PROGN (SPADLET |code| (NREVERSE |code|)) 'T)))) - (|objNew| + (mkObj (CONS 'PROGN (APPEND |code| (CONS (|wrapped2Quote| (|objVal| (|intCodeGenCOERCE| - (|objNew| |lastCode| |t1|) + (mkObj |lastCode| |t1|) |t2|))) NIL))) |t2|)) ((AND (CONSP |val|) (EQ (QCAR |val|) 'COND) (PROGN (SPADLET |conds| (QCDR |val|)) 'T)) - (|objNew| + (mkObj (CONS 'COND (PROG (G166151) (SPADLET G166151 NIL) @@ -218,14 +218,14 @@ (|wrapped2Quote| (|objVal| (|intCodeGenCOERCE| - (|objNew| |v| |t1|) |t2|))) + (mkObj |v| |t1|) |t2|))) NIL)) G166151)))))))) |t2|)) ((|absolutelyCanCoerceByCheating| |t1| |t2|) - (|objNew| |val| |t2|)) + (mkObj |val| |t2|)) ((BOOT-EQUAL |t2| '(|Any|)) - (|objNew| + (mkObj (CONS 'CONS (CONS (MKQ |t1|) (CONS |val| NIL))) |t2|)) ((AND (BOOT-EQUAL |t1| '(|Any|)) (CONSP |val|) @@ -243,7 +243,7 @@ (QCAR |ISTMP#2|)) 'T)))))) (|intCodeGenCOERCE| - (|objNew| |val'| (|removeQuote| |t1'|)) |t2|)) + (mkObj |val'| (|removeQuote| |t1'|)) |t2|)) ((AND (CONSP |t1|) (EQ (QCAR |t1|) '|Equation|) (BOOT-EQUAL |t2| |$Boolean|)) (|coerceByFunction| |triple| |t2|)) @@ -268,11 +268,11 @@ NIL))) NIL)) NIL)))) - (|objNew| |code| |t2|)) + (mkObj |code| |t2|)) ((BOOT-EQUAL |t2| |$OutputForm|) (|coerceByFunction| |triple| |t2|)) ((|isSubDomain| |t1| |$Integer|) - (|intCodeGenCOERCE| (|objNew| |val| |$Integer|) + (|intCodeGenCOERCE| (mkObj |val| |$Integer|) |t2|)) ((AND (NULL (|containsVariables| |t2|)) (|canCoerceByFunction| |t1| |t2|)) @@ -293,9 +293,9 @@ (DEFUN |intCodeGenCoerce1| (|val| |t1| |t2|) (DECLARE (SPECIAL |$mapName|)) - (|objNew| + (mkObj (CONS '|coerceOrCroak| - (CONS (|mkObjCode| (CONS '|wrap| (CONS |val| NIL)) |t1|) + (CONS (mkObjCode (CONS '|wrap| (CONS |val| NIL)) |t1|) (CONS (MKQ |t2|) (CONS (MKQ |$mapName|) NIL)))) |t2|)) diff --git a/src/interp/i-coerce.lisp.pamphlet b/src/interp/i-coerce.lisp.pamphlet index 3f07c6b..5f774d3 100644 --- a/src/interp/i-coerce.lisp.pamphlet +++ b/src/interp/i-coerce.lisp.pamphlet @@ -100,7 +100,7 @@ The special routines that do the coercions typically involve a "2" (RETURN (PROGN (OR (SPADLET |result| - (|coerceOrRetract| (|objNewWrap| |value| |t1|) + (|coerceOrRetract| (mkObjWrap |value| |t1|) |t2|)) (|coercionFailure|)) (|objValUnwrap| |result|))))) @@ -247,12 +247,12 @@ The special routines that do the coercions typically involve a "2" (COND ((BOOT-EQUAL |type| |$Any|) (SPADLET |dom| (CAR |val'|)) (SPADLET |obj| (CDR |val'|)) - (|objNewWrap| |obj| |dom|)) + (mkObjWrap |obj| |dom|)) ((AND (CONSP |type|) (EQ (QCAR |type|) '|Union|) (PROGN (SPADLET |unionDoms| (QCDR |type|)) 'T)) (|coerceUnion2Branch| |object|)) ((BOOT-EQUAL |type| |$Symbol|) - (|objNewWrap| 1 + (mkObjWrap 1 (CONS '|OrderedVariableList| (CONS (CONS |val'| NIL) NIL)))) ((AND (CONSP |type|) @@ -264,7 +264,7 @@ The special routines that do the coercions typically involve a "2" (SPADLET |var| (QCAR |ISTMP#1|)) 'T)))) (|coerceInt| - (|objNewWrap| (ELT |var| (SPADDIFFERENCE |val'| 1)) + (mkObjWrap (ELT |var| (SPADDIFFERENCE |val'| 1)) |$Symbol|) '(|Polynomial| (|Integer|)))) ((AND (CONSP |type|) (EQ (QCAR |type|) '|Polynomial|) @@ -300,10 +300,10 @@ The special routines that do the coercions typically involve a "2" (SPADLET |m| (|#| (ELT |val'| 0))) (COND ((BOOT-EQUAL |n| |m|) - (|objNew| |val| + (mkObj |val| (CONS '|SquareMatrix| (CONS |n| (CONS D NIL))))) ('T - (|objNew| |val| + (mkObj |val| (CONS '|RectangularMatrix| (CONS |n| (CONS |m| (CONS D NIL)))))))) ((AND (CONSP |type|) @@ -326,7 +326,7 @@ The special routines that do the coercions typically involve a "2" 'T)))))))) (COND ((BOOT-EQUAL |n| |m|) - (|objNew| |val| + (mkObj |val| (CONS '|SquareMatrix| (CONS |n| (CONS D NIL))))) ('T NIL))) ((AND (CONSP |type|) @@ -339,10 +339,10 @@ The special routines that do the coercions typically involve a "2" '(|Vector| |Segment| |UniversalSegment|))) (COND ((BOOT-EQUAL D |$PositiveInteger|) - (|objNew| |val| + (mkObj |val| (CONS |agg| (CONS |$NonNegativeInteger| NIL)))) ((BOOT-EQUAL D |$NonNegativeInteger|) - (|objNew| |val| (CONS |agg| (CONS |$Integer| NIL)))) + (mkObj |val| (CONS |agg| (CONS |$Integer| NIL)))) ('T NIL))) ((AND (CONSP |type|) (EQ (QCAR |type|) '|Array|) (PROGN @@ -358,12 +358,12 @@ The special routines that do the coercions typically involve a "2" 'T)))))) (COND ((BOOT-EQUAL D |$PositiveInteger|) - (|objNew| |val| + (mkObj |val| (CONS '|Array| (CONS |bds| (CONS |$NonNegativeInteger| NIL))))) ((BOOT-EQUAL D |$NonNegativeInteger|) - (|objNew| |val| + (mkObj |val| (CONS '|Array| (CONS |bds| (CONS |$Integer| NIL))))) ('T NIL))) @@ -383,11 +383,11 @@ The special routines that do the coercions typically involve a "2" 'T))))) (COND ((BOOT-EQUAL D |$PositiveInteger|) - (|objNew| |val| + (mkObj |val| (CONS '|List| (CONS |$NonNegativeInteger| NIL)))) ((BOOT-EQUAL D |$NonNegativeInteger|) - (|objNew| |val| + (mkObj |val| (CONS '|List| (CONS |$Integer| NIL)))) ((NULL |val'|) NIL) ('T (SPADLET |vl| NIL) (SPADLET |tl| NIL) @@ -402,7 +402,7 @@ The special routines that do the coercions typically involve a "2" ((BOOT-EQUAL (SPADLET |e'| (|retract| - (|objNewWrap| |e| D))) + (mkObjWrap |e| D))) '|failed|) (SPADLET |bad| 'T)) ('T @@ -439,7 +439,7 @@ The special routines that do the coercions typically involve a "2" ('T (SPADLET |e'| (|coerceInt| - (|objNewWrap| |e| |t|) |m|)) + (mkObjWrap |e| |t|) |m|)) (COND ((NULL |e'|) (RETURN NIL)) ('T @@ -447,16 +447,16 @@ The special routines that do the coercions typically involve a "2" (CONS (|objValUnwrap| |e'|) |vl'|))))))))) - (|objNewWrap| |vl'| + (mkObjWrap |vl'| (CONS '|List| (CONS |m| NIL)))))))) ((BOOT-EQUAL |D'| |$PositiveInteger|) - (|objNew| |val| + (mkObj |val| (CONS '|List| (CONS (CONS '|List| (CONS |$NonNegativeInteger| NIL)) NIL)))) ((BOOT-EQUAL |D'| |$NonNegativeInteger|) - (|objNew| |val| + (mkObj |val| (CONS '|List| (CONS (CONS '|List| (CONS |$Integer| NIL)) NIL)))) @@ -497,7 +497,7 @@ The special routines that do the coercions typically involve a "2" (PROGN (SPADLET |den| (QCDR |den|)) 'T))) NIL) ('T - (|objNewWrap| (CONS |num| |den|) + (mkObjWrap (CONS |num| |den|) (CONS |$QuotientField| (CONS D NIL)))))) ((AND (CONSP |type|) (EQ (QCAR |type|) '|SimpleAlgebraicExtension|) @@ -514,7 +514,7 @@ The special routines that do the coercions typically involve a "2" (QCDR |ISTMP#2|)) (AND (CONSP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL)))))))) - (SPADLET |val'| (|retract| (|objNew| |val| |rep|))) + (SPADLET |val'| (|retract| (mkObj |val| |rep|))) (DO () ((NULL (AND (NEQUAL |val'| '|failed|) (NEQUAL (|objMode| |val'|) @@ -578,7 +578,7 @@ The special routines that do the coercions typically involve a "2" ((NULL (SPADLET |m| (|get| |name| '|mode| |$e|))) NIL) ((|isPartialMode| |m|) NIL) - ('T (|objNew| |val| |m|)))) + ('T (mkObj |val| |m|)))) ('T NIL))))))) ;coerceOrConvertOrRetract(T,m) == @@ -658,7 +658,7 @@ The special routines that do the coercions typically involve a "2" ((BOOT-EQUAL |t2| |$OutputForm|) NIL) ((AND (|isEqualOrSubDomain| |t1| |$Integer|) (|typeIsASmallInteger| |t2|) (typep |val| 'fixnum)) - (|objNewWrap| |val| |t2|)) + (mkObjWrap |val| |t2|)) ((BOOT-EQUAL |t1| |$Integer|) NIL) ((BOOT-EQUAL |t1| |$Symbol|) NIL) ((BOOT-EQUAL |t1| |$OutputForm|) NIL) @@ -763,7 +763,7 @@ The special routines that do the coercions typically involve a "2" ('T (SPADLET $ |dcVector|) (SPADLET |object'| (|coerceUnion2Branch| - (|objNewWrap| (SPADCALL |val| |fun|) + (mkObjWrap (SPADCALL |val| |fun|) |target|))) (SPADLET |u'| (|objMode| |object'|)) (COND ((BOOT-EQUAL |u| |u'|) |object'|) ('T NIL)))))))))) @@ -1796,7 +1796,7 @@ Interpreter Coercion Query Functions ; coerceIntCommute(objNewWrap("$fromCoerceable$",t1),t2) (DEFUN |newCanCoerceCommute| (|t1| |t2|) - (|coerceIntCommute| (|objNewWrap| '|$fromCoerceable$| |t1|) |t2|)) + (|coerceIntCommute| (mkObjWrap '|$fromCoerceable$| |t1|) |t2|)) ;canCoercePermute(t1,t2) == ; -- try to generate a sequence of transpositions that will convert @@ -2189,7 +2189,7 @@ Interpreter Coercion Query Functions (COND ((OR (NULL |t2|) (BOOT-EQUAL |t2| |$EmptyMode|)) NIL) ((BOOT-EQUAL |t2| |t1|) |triple|) - ((BOOT-EQUAL |t2| '|$NoValueMode|) (|objNew| |val| |t2|)) + ((BOOT-EQUAL |t2| '|$NoValueMode|) (mkObj |val| |t2|)) ('T (COND ((AND (CONSP |t2|) (EQ (QCAR |t2|) '|SubDomain|) @@ -2207,7 +2207,7 @@ Interpreter Coercion Query Functions '((|Category|) (|Mode|) (|Domain|) (|SubDomain| (|Domain|)))) (COND - ((BOOT-EQUAL |t2| |$OutputForm|) (|objNew| |val| |t2|)) + ((BOOT-EQUAL |t2| |$OutputForm|) (mkObj |val| |t2|)) ('T NIL))) ((BOOT-EQUAL |t1| '|$NoValueMode|) (COND @@ -2222,7 +2222,7 @@ Interpreter Coercion Query Functions (SPADLET |result| (COND ((AND |expr2| (BOOT-EQUAL |t1| |val|)) - (|objNew| |val| |$OutputForm|)) + (mkObj |val| |$OutputForm|)) ((AND |expr2| (CONSP |t1|) (EQ (QCAR |t1|) '|Variable|) (PROGN @@ -2233,7 +2233,7 @@ Interpreter Coercion Query Functions (SPADLET |var| (QCAR |ISTMP#1|)) 'T)))) - (|objNewWrap| |var| |$OutputForm|)) + (mkObjWrap |var| |$OutputForm|)) ('T (|coerceInt0| |triple| |t2|)))) (COND (|expr2| (|stopTimingProcess| '|print|)) @@ -2288,7 +2288,7 @@ Interpreter Coercion Query Functions ('T (SPADLET |s1| |t1|) (SPADLET |s2| |t2|) (COND - ((BOOT-EQUAL |s1| |s2|) (RETURN (|objNew| |val| |t2|)))))) + ((BOOT-EQUAL |s1| |s2|) (RETURN (mkObj |val| |t2|)))))) (COND ((AND (NULL (|isWrapped| |val|)) (OR (NULL (AND (CONSP |t1|) @@ -2302,13 +2302,13 @@ Interpreter Coercion Query Functions (SPADLET |val'| (CDR |LETTMP#1|)) |LETTMP#1|) (SPADLET |ans| - (|coerceInt0| (|objNewWrap| |val'| |t1'|) + (|coerceInt0| (mkObjWrap |val'| |t1'|) |t2|))) |ans|) ('T (COND ((NULL (EQ |s1| |t1|)) - (SPADLET |triple| (|objNew| |val| |s1|)))) + (SPADLET |triple| (mkObj |val| |s1|)))) (COND ((SPADLET |x| (|coerceInt| |triple| |s2|)) (COND @@ -2465,7 +2465,7 @@ Interpreter Coercion Query Functions ('T (SPADLET |val| (|objVal| |triple|)) (COND ((|absolutelyCanCoerceByCheating| |t1| |t2|) - (|objNew| |val| |t2|)) + (mkObj |val| |t2|)) ((|isSubDomain| |t2| |t1|) (|coerceSubDomain| |val| |t1| |t2|)) ('T @@ -2474,30 +2474,30 @@ Interpreter Coercion Query Functions (COND ((OR (BOOT-EQUAL |t2| |$Integer|) (|typeIsASmallInteger| |t2|)) - (RETURN (|objNew| |val| |t2|))) + (RETURN (mkObj |val| |t2|))) ('T (SPADLET |sintp| (typep |val| 'fixnum)) (COND ((AND |sintp| (BOOT-EQUAL |t2| |$PositiveInteger|) (> |val| 0)) - (RETURN (|objNew| |val| |t2|))) + (RETURN (mkObj |val| |t2|))) ((AND |sintp| (BOOT-EQUAL |t2| |$NonNegativeInteger|) (>= |val| 0)) - (RETURN (|objNew| |val| |t2|)))))))) + (RETURN (mkObj |val| |t2|)))))))) (COND ((AND (|typeIsASmallInteger| |t2|) (|isEqualOrSubDomain| |t1| |$Integer|) (integerp |val|)) (COND - ((typep |val| 'fixnum) (|objNew| |val| |t2|)) + ((typep |val| 'fixnum) (mkObj |val| |t2|)) ('T NIL))) ((BOOT-EQUAL |t2| |$Void|) - (|objNew| (|voidValue|) |$Void|)) + (mkObj (|voidValue|) |$Void|)) ((BOOT-EQUAL |t2| |$Any|) - (|objNewWrap| (CONS |t1| (|unwrap| |val|)) + (mkObjWrap (CONS |t1| (|unwrap| |val|)) '(|Any|))) ((AND (BOOT-EQUAL |t1| |$Any|) (NEQUAL |t2| |$OutputForm|) @@ -2508,7 +2508,7 @@ Interpreter Coercion Query Functions |LETTMP#1|) (SPADLET |ans| (|coerceInt| - (|objNewWrap| |val'| |t1'|) + (mkObjWrap |val'| |t1'|) |t2|))) |ans|) ((OR (AND (CONSP |t1|) @@ -2525,7 +2525,7 @@ Interpreter Coercion Query Functions (AND (CONSP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (EQUAL (QCAR |ISTMP#1|) |t1|))))) - (|objNew| |val| |t2|)) + (mkObj |val| |t2|)) ((STRINGP |t2|) (COND ((AND (CONSP |t1|) @@ -2538,13 +2538,13 @@ Interpreter Coercion Query Functions (SPADLET |v| (QCAR |ISTMP#1|)) 'T))) (BOOT-EQUAL |t2| (PNAME |v|))) - (|objNewWrap| |t2| |t2|)) + (mkObjWrap |t2| |t2|)) ('T (SPADLET |val'| (|unwrap| |val|)) (COND ((AND (BOOT-EQUAL |t2| |val'|) (OR (BOOT-EQUAL |val'| |t1|) (BOOT-EQUAL |t1| |$String|))) - (|objNew| |val| |t2|)) + (mkObj |val| |t2|)) ('T NIL))))) ((AND (CONSP |t1|) (EQ (QCAR |t1|) '|Tuple|) (PROGN @@ -2555,7 +2555,7 @@ Interpreter Coercion Query Functions (SPADLET S (QCAR |ISTMP#1|)) 'T)))) (|coerceInt1| - (|objNewWrap| + (mkObjWrap (|asTupleAsList| (|unwrap| |val|)) (CONS '|List| (CONS S NIL))) |t2|)) @@ -2565,7 +2565,7 @@ Interpreter Coercion Query Functions (|coerceInt2Union| |triple| |t2|)) ((AND (STRINGP |t1|) (BOOT-EQUAL |t2| |$String|)) - (|objNew| |val| |$String|)) + (mkObj |val| |$String|)) ((AND (STRINGP |t1|) (CONSP |t2|) (EQ (QCAR |t2|) '|Variable|) (PROGN @@ -2577,13 +2577,13 @@ Interpreter Coercion Query Functions 'T)))) (COND ((BOOT-EQUAL |t1| (PNAME |v|)) - (|objNewWrap| |v| |t2|)) + (mkObjWrap |v| |t2|)) ('T NIL))) ((AND (STRINGP |t1|) (BOOT-EQUAL |t1| (|unwrap| |val|))) (COND ((BOOT-EQUAL |t2| |$OutputForm|) - (|objNew| |t1| |$OutputForm|)) + (mkObj |t1| |$OutputForm|)) ('T NIL))) ((ATOM |t1|) NIL) ('T @@ -2679,14 +2679,14 @@ Interpreter Coercion Query Functions (SPADLET |fun| (|getFunctionFromDomain| (|unwrap| |val|) |dc| |argl|)) - (|objNewWrap| |fun| |t2|)) + (mkObjWrap |fun| |t2|)) ('T (SPADLET |val| (|NRTcompileEvalForm| (|unwrap| |val|) (CDR (CAAR |mms|)) (|evalDomain| |dc|))) - (|objNew| |val| |t2|)))))) + (mkObj |val| |t2|)))))) ((AND (CONSP |t1|) (EQ (QCAR |t1|) '|Variable|) (PROGN @@ -2731,11 +2731,11 @@ Interpreter Coercion Query Functions (PROGN (SPADLET |freeFun| (QCDR |dc|)) 'T)) - (EXIT (|objNew| |freeFun| |t2|)))) + (EXIT (mkObj |freeFun| |t2|)))) (COND (|$genValue| (EXIT - (|objNewWrap| + (mkObjWrap (|getFunctionFromDomain| |sym| |dc| |argl|) |t2|)))) @@ -2743,7 +2743,7 @@ Interpreter Coercion Query Functions (|NRTcompileEvalForm| |sym| (CDR (CAAR |mms|)) (|evalDomain| |dc|))) - (|objNew| |val| |t2|))) + (mkObj |val| |t2|))) ((AND (CONSP |t1|) (EQ (QCAR |t1|) '|FunctionCalled|) (PROGN @@ -2841,7 +2841,7 @@ Interpreter Coercion Query Functions ('T NIL))) (COND ((NULL |intName|) NIL) - ('T (|objNewWrap| |intName| |t2|)))))))) + ('T (mkObjWrap |intName| |t2|)))))))) ((AND (CONSP |t1|) (EQ (QCAR |t1|) '|FunctionCalled|) (PROGN @@ -2895,7 +2895,7 @@ Interpreter Coercion Query Functions (OR |ans| (AND (|isSubDomain| |t1| |$Integer|) (|coerceInt| - (|objNew| |val| |$Integer|) |t2|)) + (mkObj |val| |$Integer|) |t2|)) (|coerceIntAlgebraicConstant| |triple| |t2|) (|coerceIntX| |val| |t1| |t2|))))))))))))))))) @@ -2939,7 +2939,7 @@ Interpreter Coercion Query Functions (SPADLET |predfn| (|getSubDomainPredicate| |tSuper| |tSub| |pred|)) (COND - ((FUNCALL |predfn| |val| NIL) (|objNew| |val| |tSub|)) + ((FUNCALL |predfn| |val| NIL) (mkObj |val| |tSub|)) ('T NIL)))))) ;getSubDomainPredicate(tSuper, tSub, pred) == @@ -3016,7 +3016,7 @@ Interpreter Coercion Query Functions ((NULL (SPADLET |t0| (|underDomainOf| |t2|))) NIL) ('T (|coerceInt| - (|objNewWrap| |val| (CONS '|List| (CONS |t0| NIL))) + (mkObjWrap |val| (CONS '|List| (CONS |t0| NIL))) |t2|)))) ('T NIL))) ('T NIL))))) @@ -3066,12 +3066,12 @@ Interpreter Coercion Query Functions (|ofCategory| |t2| '(|Monoid|)) (BOOT-EQUAL |val| (|getConstantFromDomain| '(|One|) |t1|))) - (|objNewWrap| (|getConstantFromDomain| '(|One|) |t2|) |t2|)) + (mkObjWrap (|getConstantFromDomain| '(|One|) |t2|) |t2|)) ((AND (|ofCategory| |t1| '(|AbelianMonoid|)) (|ofCategory| |t2| '(|AbelianMonoid|)) (BOOT-EQUAL |val| (|getConstantFromDomain| '(|Zero|) |t1|))) - (|objNewWrap| (|getConstantFromDomain| '(|Zero|) |t2|) |t2|)) + (mkObjWrap (|getConstantFromDomain| '(|Zero|) |t2|) |t2|)) ('T NIL)))))) ;stripUnionTags doms == @@ -3228,8 +3228,8 @@ Interpreter Coercion Query Functions (PROGN (SPADLET |p| (QCAR |ISTMP#2|)) 'T)))))) - (|objNewWrap| (CDR |val'|) |targetType|)) - ('T (|objNew| (|objVal| |object|) |targetType|))))))))) + (mkObjWrap (CDR |val'|) |targetType|)) + ('T (mkObj (|objVal| |object|) |targetType|))))))))) ;coerceBranch2Union(object,union) == ; -- assumes type is a member of unionDoms @@ -3273,10 +3273,10 @@ Interpreter Coercion Query Functions (PROGN (SPADLET |tag| (QCAR |ISTMP#3|)) 'T))))))) - (|objNewWrap| + (mkObjWrap (CONS (|removeQuote| |tag|) (|unwrap| |val|)) |union|)) - ('T (|objNew| |val| |union|))))))))) + ('T (mkObj |val| |union|))))))))) ;coerceInt2Union(object,union) == ; -- coerces to a Union type, adding numeric tags @@ -3310,7 +3310,7 @@ Interpreter Coercion Query Functions (COND ((AND (BOOT-EQUAL |t1| |$String|) (|member| |val'| |unionDoms|)) - (|coerceBranch2Union| (|objNew| |val| |val'|) + (|coerceBranch2Union| (mkObj |val| |val'|) |union|)) ('T (SPADLET |noCoerce| 'T) (SPADLET |val'| NIL) (SEQ (DO ((G167805 |unionDoms| (CDR G167805)) @@ -3403,7 +3403,7 @@ Interpreter Coercion Query Functions '(|List| |Vector| |Segment| |Stream| |UniversalSegment| |Array|)) (|isSubDomain| |u1| |u2|)) - (|objNew| (|objVal| |triple|) |t2|)) + (mkObj (|objVal| |triple|) |t2|)) ('T (SPADLET |args| (CONS (CONS '|Mapping| @@ -3458,7 +3458,7 @@ Interpreter Coercion Query Functions (COND ((BOOT-EQUAL |val| |$coerceFailure|) NIL) - ('T (|objNewWrap| |val| |t2|))))))))))))))))))))) + ('T (mkObjWrap |val| |t2|))))))))))))))))))))) ;coerceIntByMapInner(arg,[u1,:u2]) == coerceOrThrowFailure(arg,u1,u2) @@ -3530,7 +3530,7 @@ Interpreter Coercion Query Functions (EXIT (PROGN (SPADLET |trip| - (|objNewWrap| |a1| |m1|)) + (mkObjWrap |a1| |m1|)) (SPADLET |newVal| (|coerceInt| |trip| |m2|)) (COND @@ -3752,7 +3752,7 @@ Interpreter Coercion Query Functions 'T)))))))) (SPADLET |val| (|objVal| |triple|)) (COND - ((BOOT-EQUAL |fun| '|Identity|) (|objNew| |val| |t2|)) + ((BOOT-EQUAL |fun| '|Identity|) (mkObj |val| |t2|)) ((BOOT-EQUAL |tag| '|total|) (OR (|coerceByTable| |fun| |val| |t1| |t2| 'T) (|coerceByFunction| |triple| |t2|))) @@ -3835,7 +3835,7 @@ Interpreter Coercion Query Functions (COND ((BOOT-EQUAL |c| |$coerceFailure|) NIL) ((BOOT-EQUAL |u| '|$fromCoerceable$|) |c|) - ('T (|objNewWrap| |c| |target|)))) + ('T (mkObjWrap |c| |target|)))) ('T NIL))) ('T NIL)))))))) @@ -4171,15 +4171,15 @@ Interpreter Coercion Query Functions (FUNCALL |fn| |x| |t1| |t2|))) (COND ((BOOT-EQUAL |c| |$coerceFailure|) NIL) - ('T (|objNewWrap| |c| |t2|)))) + ('T (mkObjWrap |c| |t2|)))) (|isTotalCoerce| - (|objNew| + (mkObj (CONS |fn| (CONS |x| (CONS (MKQ |t1|) (CONS (MKQ |t2|) NIL)))) |t2|)) ('T - (|objNew| + (mkObj (CONS '|catchCoerceFailure| (CONS (MKQ |fn|) (CONS |x| @@ -4294,7 +4294,7 @@ Interpreter Coercion Query Functions (SPADLET |fn| (CAR |fun|)) (SPADLET |d| (CDR |fun|)) (COND ((|isWrapped| |x|) (SPADLET |x| (|unwrap| |x|)) - (|mkObjWrap| (SPADCALL (CAR |x|) (CDR |x|) |fun|) + (mkObjWrap (SPADCALL (CAR |x|) (CDR |x|) |fun|) |m2|)) ((NULL (AND (CONSP |x|) (EQ (QCAR |x|) 'SPADCALL) (PROGN @@ -4313,7 +4313,7 @@ Interpreter Coercion Query Functions (SPADLET |code| (CONS 'SPADCALL (CONS |a| (CONS |b| (CONS |fun| NIL))))) - (|objNew| |code| |$Boolean|)))) + (mkObj |code| |$Boolean|)))) ('T (COND ((NULL (SPADLET |mm| @@ -4347,7 +4347,7 @@ Interpreter Coercion Query Functions (SPADCALL (|unwrap| |x|) |fun|))) (COND ((BOOT-EQUAL |val| |$coerceFailure|) NIL) - ('T (|objNewWrap| |val| |m2|)))) + ('T (mkObjWrap |val| |m2|)))) ('T (SPADLET |env| |fun|) (SPADLET |code| (CONS '|failCheck| @@ -4355,12 +4355,12 @@ Interpreter Coercion Query Functions (CONS 'SPADCALL (CONS |x| (CONS |env| NIL))) NIL))) - (|objNew| |code| |m2|)))) + (mkObj |code| |m2|)))) ('T (SPADLET |m1'| |m1|) (SPADLET |m2'| |m2|) (COND ((OR (NEQUAL |m1| |m1'|) (NEQUAL |m2| |m2'|)) - (|coerceByFunction| (|objNew| |x| |m1'|) |m2'|)) + (|coerceByFunction| (mkObj |x| |m1'|) |m2'|)) ('T NIL)))))))))))) ;hasCorrectTarget(m,sig is [dc,tar,:.]) == diff --git a/src/interp/i-coerfn.lisp.pamphlet b/src/interp/i-coerfn.lisp.pamphlet index 1fb1e8a..6e22e7e 100755 --- a/src/interp/i-coerfn.lisp.pamphlet +++ b/src/interp/i-coerfn.lisp.pamphlet @@ -106,7 +106,7 @@ all these coercion functions have the following result: ((BOOT-EQUAL |u| '|$fromCoerceable$|) (|canCoerce| S T$)) ((NULL (SPADLET |u'| (|coerceInt| - (|objNewWrap| |u| + (mkObjWrap |u| (CONS '|Vector| (CONS S NIL))) (CONS '|Vector| (CONS T$ NIL))))) (|coercionFailure|)) @@ -187,7 +187,7 @@ all these coercion functions have the following result: (CONS 0 G166139)))))))))) (COND ((SPADLET |z| - (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|objValUnwrap| |z|)) ('T (|coercionFailure|)))) ((SPADLET |v| (|intersection| |v1| |v2|)) @@ -326,7 +326,7 @@ all these coercion functions have the following result: (COND ((SPADLET |z| (|coerceInt| - (|objNewWrap| + (mkObjWrap (CONS (CONS |exp| |c|) NIL) |t|) |target|)) @@ -462,7 +462,7 @@ all these coercion functions have the following result: NIL) (SEQ (EXIT (COND ((SPADLET |z| - (|coerceInt| (|objNewWrap| |c| S) + (|coerceInt| (mkObjWrap |c| S) |target|)) (SPADLET |li| (VEC2LIST |e|)) (SPADLET |a| @@ -540,7 +540,7 @@ all these coercion functions have the following result: ((NULL |vars|) (SPADLET |c| (CDAR |u|)) (COND ((NULL (SPADLET |c| - (|coerceInt| (|objNewWrap| |c| S) + (|coerceInt| (mkObjWrap |c| S) |target|))) (|coercionFailure|)) ('T (|objValUnwrap| |c|)))) @@ -561,7 +561,7 @@ all these coercion functions have the following result: (CONS (|objValUnwrap| (|coerceInt| - (|objNewWrap| |var| |$Symbol|) + (mkObjWrap |var| |$Symbol|) |target|)) G166499)))))))) (SPADLET |sum| (|domainZero| |target|)) @@ -587,7 +587,7 @@ all these coercion functions have the following result: (SEQ (EXIT (COND ((NULL (SPADLET |c| (|coerceInt| - (|objNewWrap| |c| S) |target|))) + (mkObjWrap |c| S) |target|))) (|coercionFailure|)) ('T (SPADLET |c| (|objValUnwrap| |c|)) (SPADLET |term| (|domainOne| |target|)) @@ -656,7 +656,7 @@ all these coercion functions have the following result: ((NULL |u|) (|domainZero| |target|)) ((NEQUAL |x| |y|) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |u| |source|) + (|coerceInt| (mkObjWrap |u| |source|) |source'|)) (|coercionFailure|)) (OR (SPADLET |u'| (|coerceInt| |u'| |target|)) @@ -718,7 +718,7 @@ all these coercion functions have the following result: (SEQ (EXIT (COND (|bad| NIL) ((NULL (SPADLET |c'| - (|coerceInt| (|objNewWrap| |c| S) + (|coerceInt| (mkObjWrap |c| S) T$))) (RETURN (SPADLET |bad| 'T))) ('T @@ -795,7 +795,7 @@ all these coercion functions have the following result: ((BOOT-EQUAL |u| '|$fromCoerceable$|) (|canCoerce| |source| |target'|)) ((SPADLET |u'| - (|coerceInt| (|objNewWrap| |u| |source|) |target'|)) + (|coerceInt| (mkObjWrap |u| |source|) |target'|)) (COND ((SPADLET |u''| (|coerceInt| |u'| |target|)) (|objValUnwrap| |u''|)) @@ -915,7 +915,7 @@ all these coercion functions have the following result: (AND (CONSP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL)))) (SPADLET |mp| - (OR (|coerceInt| (|objNewWrap| |u| |source|) + (OR (|coerceInt| (mkObjWrap |u| |source|) (CONS '|MultivariatePolynomial| (CONS |vl| (CONS S NIL)))) (|coercionFailure|))) @@ -941,7 +941,7 @@ all these coercion functions have the following result: (CONS |vl'| (CONS S NIL)))) (SPADLET |u'| (|sortAndReorderDmpExponents| |u| |vl|)) (SPADLET |u'| - (|coerceInt| (|objNewWrap| |u'| |source'|) + (|coerceInt| (mkObjWrap |u'| |source'|) |target'|)) (COND (|u'| (SPADLET |u'| @@ -949,7 +949,7 @@ all these coercion functions have the following result: (|objValUnwrap| |u'|) |vl'|)) (SPADLET |u'| (|coerceInt| - (|objNewWrap| |u'| + (mkObjWrap |u'| (CONS '|Polynomial| (CONS S NIL))) |target|)))) (COND @@ -981,11 +981,11 @@ all these coercion functions have the following result: (SEQ (EXIT (PROGN (OR (SPADLET |c'| (|coerceInt| - (|objNewWrap| |c| S) |target|)) + (mkObjWrap |c| S) |target|)) (|coercionFailure|)) (OR (SPADLET |e'| (|coerceInt| - (|objNewWrap| + (mkObjWrap (CONS (CONS |e| |oneT|) NIL) |source'|) |target|)) @@ -1141,13 +1141,13 @@ all these coercion functions have the following result: (AND G166951 (EQL 0 (ELT |e| |i|)))))))))) (OR (SPADLET |x| - (|coerceInt| (|objNewWrap| |c| S) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|coercionFailure|)) (|objValUnwrap| |x|)) ((NULL (|member| |var| |vl|)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |u| |source|) + (|coerceInt| (mkObjWrap |u| |source|) T$)) (|coercionFailure|)) (CONS (CONS 0 (|objValUnwrap| |u'|)) NIL)) @@ -1187,7 +1187,7 @@ all these coercion functions have the following result: G166968)))))))))) (OR (SPADLET |u'| (|coerceInt| - (|objNewWrap| |u'| + (mkObjWrap |u'| (CONS |up| (CONS |var| (CONS S NIL)))) |target|)) @@ -1223,7 +1223,7 @@ all these coercion functions have the following result: (COND ((SPADLET |y| (|coerceInt| - (|objNewWrap| + (mkObjWrap (CONS (CONS |e1| |c|) NIL) S1) T$)) (COND @@ -1311,7 +1311,7 @@ all these coercion functions have the following result: (SPADLET |u'| (|addDmpLikeTermsAsTarget| |u| |source'|)) (COND ((SPADLET |u''| - (|coerceInt| (|objNewWrap| |u'| |source'|) + (|coerceInt| (mkObjWrap |u'| |source'|) |target|)) (|objValUnwrap| |u''|)) ('T (|coercionFailure|))))))))))) @@ -1349,7 +1349,7 @@ all these coercion functions have the following result: (SPADLET |u'| (|addDmpLikeTermsAsTarget| |u| |source'|)) (COND ((SPADLET |u''| - (|coerceInt| (|objNewWrap| |u'| |source'|) + (|coerceInt| (mkObjWrap |u'| |source'|) |target'|)) (|addDmpLikeTermsAsTarget| (|objValUnwrap| |u''|) |target|)) @@ -1396,7 +1396,7 @@ all these coercion functions have the following result: (COND ((NULL (SPADLET |z| (|coerceInt| - (|objNewWrap| |cf| + (mkObjWrap |cf| (CONS '|Complex| (CONS |$Float| NIL))) (CONS '|Complex| @@ -1456,12 +1456,12 @@ all these coercion functions have the following result: (COND ((NULL (SPADLET |z| (|coerceInt| - (|objNewWrap| |u| |source|) T$))) + (mkObjWrap |u| |source|) T$))) (|coercionFailure|)) ('T (CONS (CONS (LIST2VEC NIL) (|objValUnwrap| |z|)) NIL)))) - ('T (SPADLET |obj| (|objNewWrap| |u| |source|)) + ('T (SPADLET |obj| (mkObjWrap |u| |source|)) (SPADLET |univ| (|coerceInt| |obj| (CONS '|UnivariatePolynomial| @@ -1489,7 +1489,7 @@ all these coercion functions have the following result: ((NULL (SPADLET |c| (|coerceInt| - (|objNewWrap| |c| |source|) + (mkObjWrap |c| |source|) T$))) (|coercionFailure|)) ('T @@ -1588,13 +1588,13 @@ all these coercion functions have the following result: (COND ((NULL (SPADLET |c| (|coerceInt| - (|objNewWrap| |c| |source|) T$))) + (mkObjWrap |c| |source|) T$))) (|coercionFailure|)) ('T (SPADLET |c| (|objValUnwrap| |c|)))))) (SPADLET |summands| (CONS (CONS |vec| |c|) |summands|))) ('T (SPADLET |univ| - (|coerceInt| (|objNewWrap| |c| |source|) + (|coerceInt| (mkObjWrap |c| |source|) (CONS '|UnivariatePolynomial| (CONS (CAR |varList|) (CONS T$ NIL))))) (SPADLET |univ| (|objValUnwrap| |univ|)) @@ -1643,7 +1643,7 @@ all these coercion functions have the following result: (SPADLET |d| (|Expr2Dmp| |u| |source| |dmp|)) (COND ((NULL (SPADLET |m| - (|coerceInt| (|objNewWrap| |d| |dmp|) + (|coerceInt| (mkObjWrap |d| |dmp|) |target|))) (|coercionFailure|)) ('T (|objValUnwrap| |m|))))))))) @@ -1732,7 +1732,7 @@ all these coercion functions have the following result: (COND ((SPADLET |z| (|coerceInt| - (|objNewWrap| |numer| |uniType|) + (mkObjWrap |numer| |uniType|) |target|)) (|objValUnwrap| |z|)) ('T (|coercionFailure|)))))))))))))) @@ -1756,17 +1756,17 @@ all these coercion functions have the following result: (COND ((BOOT-EQUAL |u| '|$fromCoerceable$|) (|canCoerce| S T$)) ((NULL (SPADLET |m| - (|coerceInt| (|objNewWrap| |u| |source|) S))) + (|coerceInt| (mkObjWrap |u| |source|) S))) (|coercionFailure|)) ('T (SPADLET |u'| (|objValUnwrap| |m|)) (COND ((NULL (SPADLET |m'| - (|coerceInt| (|objNewWrap| |u'| S) T$))) + (|coerceInt| (mkObjWrap |u'| S) T$))) (|coercionFailure|)) ('T (SPADLET |u''| (|objValUnwrap| |m'|)) (COND ((NULL (SPADLET |m''| - (|coerceInt| (|objNewWrap| |u''| T$) + (|coerceInt| (mkObjWrap |u''| T$) |target|))) (|coercionFailure|)) ('T (|objValUnwrap| |m''|))))))))))) @@ -1788,12 +1788,12 @@ all these coercion functions have the following result: (|canCoerce| S |target|)) ((NULL (SPADLET |m| (|coerceByFunction| - (|objNewWrap| |u| |source|) S))) + (mkObjWrap |u| |source|) S))) (|coercionFailure|)) ('T (SPADLET |u'| (|objValUnwrap| |m|)) (COND ((NULL (SPADLET |m'| - (|coerceInt| (|objNewWrap| |u'| S) + (|coerceInt| (mkObjWrap |u'| S) |target|))) (|coercionFailure|)) ('T (|objValUnwrap| |m'|))))))))) @@ -1823,7 +1823,7 @@ all these coercion functions have the following result: ('T (SPADLET |u'| (|unwrap| |u|)) (SPADLET |unit'| (|coerceInt| - (|objNewWrap| (CAR |u'|) |oldargmode|) + (mkObjWrap (CAR |u'|) |oldargmode|) |newargmode|)) (COND ((NULL |unit'|) (|coercionFailure|)) @@ -1861,7 +1861,7 @@ all these coercion functions have the following result: (RETURN (PROGN (SPADLET |fac'| - (|coerceInt| (|objNewWrap| (ELT |ffe| 1) |oldmode|) + (|coerceInt| (mkObjWrap (ELT |ffe| 1) |oldmode|) |newmode|)) (COND ((NULL |fac'|) '|failed|) @@ -1892,7 +1892,7 @@ all these coercion functions have the following result: (COND ((BOOT-EQUAL |i| (|domainZero| S)) (SPADLET |LETTMP#1| - (OR (|coerceInt| (|objNewWrap| |r| S) |target|) + (OR (|coerceInt| (mkObjWrap |r| S) |target|) (|coercionFailure|))) (SPADLET |r'| (CAR |LETTMP#1|)) |r'|) ('T (|coercionFailure|))))))))) @@ -1980,7 +1980,7 @@ all these coercion functions have the following result: ('T (SPADLET E (|defaultTargetFE| |source|)) (SPADLET |negOne| (|coerceInt| - (|objNewWrap| (SPADDIFFERENCE 1) |$Integer|) E)) + (mkObjWrap (SPADDIFFERENCE 1) |$Integer|) E)) (COND ((NULL |negOne|) (|coercionFailure|)) ('T @@ -1997,12 +1997,12 @@ all these coercion functions have the following result: (SPADLET |real| (SPADCALL |u| |realFun|)) (SPADLET |imag| (SPADCALL |u| |imagFun|)) (SPADLET |realExp| - (|coerceInt| (|objNewWrap| |real| S) E)) + (|coerceInt| (mkObjWrap |real| S) E)) (COND ((NULL |realExp|) (|coercionFailure|)) ('T (SPADLET |imagExp| - (|coerceInt| (|objNewWrap| |imag| S) E)) + (|coerceInt| (mkObjWrap |imag| S) E)) (COND ((NULL |imagExp|) (|coercionFailure|)) ('T @@ -2018,7 +2018,7 @@ all these coercion functions have the following result: (|objValUnwrap| |imagExp|) |timesFun|) |plusFun|)) - (SPADLET |newObj| (|objNewWrap| |newVal| E)) + (SPADLET |newObj| (mkObjWrap |newVal| E)) (SPADLET |finalObj| (|coerceInt| |newObj| |target|)) (COND @@ -2086,7 +2086,7 @@ all these coercion functions have the following result: (COND ((BOOT-EQUAL |val| '|$fromCoerceable$|) (|canCoerce| S T$)) ((NULL (SPADLET |object| - (|coerceInt1| (|mkObjWrap| |val| |source|) + (|coerceInt1| (mkObjWrap |val| |source|) (CONS '|List| (CONS T$ NIL))))) (|coercionFailure|)) ('T (|asTupleNew0| (|objValUnwrap| |object|)))))))) @@ -2112,7 +2112,7 @@ all these coercion functions have the following result: ('T (OR (SPADLET |v| (|coerceInt| - (|objNewWrap| (LIST2VEC |l|) + (mkObjWrap (LIST2VEC |l|) (CONS '|Vector| (CONS S NIL))) (CONS '|Vector| (CONS T$ NIL)))) (|coercionFailure|)) @@ -2140,7 +2140,7 @@ all these coercion functions have the following result: ((NEQUAL |n| (SIZE |v|)) (|coercionFailure|)) ('T (OR (SPADLET |v1| - (|coerceInt| (|objNewWrap| |v| |source|) + (|coerceInt| (mkObjWrap |v| |source|) (CONS '|Vector| (CONS T$ NIL)))) (|coercionFailure|)) (SPADLET |dpFun| @@ -2165,7 +2165,7 @@ all these coercion functions have the following result: ('T (OR (SPADLET |v| (|coerceInt| - (|objNewWrap| (LIST2VEC |l|) + (mkObjWrap (LIST2VEC |l|) (CONS '|Vector| (CONS S NIL))) |target|)) (|coercionFailure|)) @@ -2188,7 +2188,7 @@ all these coercion functions have the following result: ('T (OR (SPADLET |l| (|coerceInt| - (|objNewWrap| (VEC2LIST |v|) + (mkObjWrap (VEC2LIST |v|) (CONS '|List| (CONS S NIL))) |target|)) (|coercionFailure|)) @@ -2241,7 +2241,7 @@ all these coercion functions have the following result: (OR (SPADLET |y'| (|coerceInt| - (|objNewWrap| |y| E) R)) + (mkObjWrap |y| E) R)) (|coercionFailure|)) (SPADLET |x'| (CONS (|objValUnwrap| |y'|) @@ -2303,7 +2303,7 @@ all these coercion functions have the following result: (SPADLET T$ (OR (|coerceInt| - (|objNewWrap| |x| D) |D'|) + (mkObjWrap |x| D) |D'|) (RETURN '|failed|))) (|objValUnwrap| T$)) G167811)))))))) @@ -2382,7 +2382,7 @@ all these coercion functions have the following result: ((BOOT-EQUAL |x| '|$fromCoerceable$|) (|canCoerce| S T$)) ('T (SPADLET |target'| (CONS '|Set| (CONS S NIL))) (SPADLET |u| - (|objNewWrap| + (mkObjWrap (SPADCALL |x| (|getFunctionFromDomain| '|brace| |target'| (CONS |source| NIL))) @@ -2411,7 +2411,7 @@ all these coercion functions have the following result: ((BOOT-EQUAL |x| '|$fromCoerceable$|) (|canCoerce| S T$)) ('T (SPADLET |u| - (|objNewWrap| + (mkObjWrap (SPADCALL |x| (|getFunctionFromDomain| '|destruct| |source| (CONS |source| NIL))) @@ -2440,7 +2440,7 @@ all these coercion functions have the following result: ((BOOT-EQUAL S T$) (|coercionFailure|)) ('T (SPADLET |target'| (CONS |agg1| (CONS T$ NIL))) (OR (SPADLET |u| - (|coerceInt| (|objNewWrap| |x| |source|) + (|coerceInt| (mkObjWrap |x| |source|) |target'|)) (|coercionFailure|)) (OR (SPADLET |u| (|coerceInt| |u| |target|)) @@ -2468,7 +2468,7 @@ all these coercion functions have the following result: (|canCoerce| |mid| |target|))) ('T (OR (SPADLET |u| - (|coerceInt| (|objNewWrap| |x| |source|) |mid|)) + (|coerceInt| (mkObjWrap |x| |source|) |mid|)) (|coercionFailure|)) (OR (SPADLET |u| (|coerceInt| |u| |target|)) (|coercionFailure|)) @@ -2524,7 +2524,7 @@ all these coercion functions have the following result: (|canCoerce| |mid| |target|)) ('T (OR (SPADLET |u| - (|coerceInt| (|objNewWrap| |x| |mid|) |target|)) + (|coerceInt| (mkObjWrap |x| |mid|) |target|)) (|coercionFailure|)) (|objValUnwrap| |u|))))))) @@ -2567,7 +2567,7 @@ all these coercion functions have the following result: (OR (SPADLET |y'| (|coerceInt| - (|objNewWrap| |y| R) S)) + (mkObjWrap |y| R) S)) (|coercionFailure|)) (SPADLET |u| (CONS (|objValUnwrap| |y'|) @@ -2641,7 +2641,7 @@ all these coercion functions have the following result: (|canCoerce| |mid| |target|)) ('T (OR (SPADLET |u| - (|coerceInt| (|objNewWrap| |x| |mid|) |target|)) + (|coerceInt| (mkObjWrap |x| |mid|) |target|)) (|coercionFailure|)) (|objValUnwrap| |u|))))))) @@ -2682,7 +2682,7 @@ all these coercion functions have the following result: (PROGN (SPADLET |c| (QCDR |u|)) 'T)) (COND ((NULL (SPADLET |u'| - (|coerceInt| (|objNewWrap| |c| S) + (|coerceInt| (mkObjWrap |c| S) |target|))) (|coercionFailure|)) ('T (|objValUnwrap| |u'|)))) @@ -2697,7 +2697,7 @@ all these coercion functions have the following result: (SPADLET |zero| (|domainZero| S)) (OR (SPADLET |u'| (|coerceInt| - (|objNewWrap| + (mkObjWrap (|Mp2SimilarDmp| |u| S (|#| |x|) |plus| |mult| |one| |zero|) |target'|) @@ -2783,7 +2783,7 @@ all these coercion functions have the following result: (CONS |vars| (CONS S NIL)))) (COND ((NULL (SPADLET |d| - (|coerceInt| (|objNewWrap| |u| |source|) + (|coerceInt| (mkObjWrap |u| |source|) |dmp|))) (|coercionFailure|)) ('T (|Dmp2Expr| (|objValUnwrap| |d|) |dmp| |target|))))))))) @@ -2926,7 +2926,7 @@ all these coercion functions have the following result: ((AND (CONSP |u|) (EQUAL (QCAR |u|) 0) (PROGN (SPADLET |c| (QCDR |u|)) 'T)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|coercionFailure|)) (|objValUnwrap| |u'|)) ('T @@ -2963,7 +2963,7 @@ all these coercion functions have the following result: |univariate| S NIL)) (OR (SPADLET |u'| (|coerceInt| - (|objNewWrap| |u'| + (mkObjWrap |u'| (CONS |mp| (CONS |common| (CONS @@ -2975,7 +2975,7 @@ all these coercion functions have the following result: (|objValUnwrap| |u'|)) ('T (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |u| |source|) + (|coerceInt| (mkObjWrap |u| |source|) (CONS |mp| (CONS |common| (CONS @@ -3013,7 +3013,7 @@ all these coercion functions have the following result: ((AND (CONSP |u|) (EQUAL (QCAR |u|) 0) (PROGN (SPADLET |c| (QCDR |u|)) 'T)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|coercionFailure|)) (|objValUnwrap| |u'|)) ('T (SPADLET |var| (CADR |u|)) @@ -3022,7 +3022,7 @@ all these coercion functions have the following result: (SPADLET T$ (CADDR |target|)) (SPADLET |x| (OR (|coerceInt| - (|objNewWrap| + (mkObjWrap (ELT |vars| (SPADDIFFERENCE |var| 1)) (CONS '|Variable| @@ -3079,7 +3079,7 @@ all these coercion functions have the following result: ((AND (CONSP |u|) (EQUAL (QCAR |u|) 0) (PROGN (SPADLET |c| (QCDR |u|)) 'T)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|coercionFailure|)) (|objValUnwrap| |u'|)) ('T (SPADLET |var| (CADR |u|)) @@ -3152,7 +3152,7 @@ all these coercion functions have the following result: ((AND (CONSP |u|) (EQUAL (QCAR |u|) 0) (PROGN (SPADLET |c| (QCDR |u|)) 'T)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |c| S) + (|coerceInt| (mkObjWrap |c| S) |mp2|)) (|coercionFailure|)) (|objValUnwrap| |u'|)) @@ -3327,7 +3327,7 @@ all these coercion functions have the following result: (SPADLET |u'| (|translateMpVars2PVars| |u'| |vl'|)) (OR (SPADLET |u'| (|coerceInt| - (|objNewWrap| |u'| (CONS |p| (CONS S NIL))) + (mkObjWrap |u'| (CONS |p| (CONS S NIL))) |target|)) (|coercionFailure|)) (|objValUnwrap| |u'|))))))) @@ -3355,7 +3355,7 @@ all these coercion functions have the following result: ((AND (CONSP |u|) (EQUAL (QCAR |u|) 0) (PROGN (SPADLET |c| (QCDR |u|)) 'T)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |c| PS) PR)) + (|coerceInt| (mkObjWrap |c| PS) PR)) (|coercionFailure|)) (|objValUnwrap| |u'|)) ('T (SPADLET |pos| (CADR |u|)) (SPADLET |ec| (CDDR |u|)) @@ -3448,13 +3448,13 @@ all these coercion functions have the following result: ((AND (CONSP |u|) (EQUAL (QCAR |u|) 0) (PROGN (SPADLET |c| (QCDR |u|)) 'T)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |c| S) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|coercionFailure|)) (|objValUnwrap| |u'|)) ((NULL (|member| |x| |vl|)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |u| |source|) + (|coerceInt| (mkObjWrap |u| |source|) T$)) (|coercionFailure|)) (CONS (CONS 0 (|objValUnwrap| |u'|)) NIL)) @@ -3484,7 +3484,7 @@ all these coercion functions have the following result: (CONS (CONS |e| |c|) G168712)))))))) (OR (SPADLET |u'| (|coerceInt| - (|objNewWrap| |u'| + (mkObjWrap |u'| (CONS |up| (CONS |x| (CONS S NIL)))) |target|)) @@ -3504,7 +3504,7 @@ all these coercion functions have the following result: NIL)))) (SPADLET |upU| (SPADCALL |u| |var| |univariate|)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |upU| UPP) + (|coerceInt| (mkObjWrap |upU| UPP) |target|)) (|coercionFailure|)) (|objValUnwrap| |u'|)))))))) @@ -3612,7 +3612,7 @@ all these coercion functions have the following result: (CONS |v| (CONS T$ NIL)))) (OR (SPADLET |u'| (|coerceInt| - (|objNewWrap| |val'| |source'|) + (mkObjWrap |val'| |source'|) |target|)) (|coercionFailure|)) (|objValUnwrap| |u'|)))))))))) @@ -3773,7 +3773,7 @@ all these coercion functions have the following result: ((AND (CONSP |u|) (EQUAL (QCAR |u|) 0) (PROGN (SPADLET |c| (QCDR |u|)) 'T)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|coercionFailure|)) (|objValUnwrap| |u'|)) ('T @@ -3814,7 +3814,7 @@ all these coercion functions have the following result: ((BOOT-EQUAL S T$) (|coercionFailure|)) ('T (SPADLET |newS| (CONS '|Polynomial| (CONS T$ NIL))) (SPADLET |val| - (|coerceInt| (|objNewWrap| |u| |source|) |newS|)) + (|coerceInt| (mkObjWrap |u| |source|) |newS|)) (COND ((NULL |val|) (|coercionFailure|)) ('T (SPADLET |val| (|coerceInt| |val| |target|)) @@ -3859,12 +3859,12 @@ all these coercion functions have the following result: ((AND (CONSP |u|) (EQUAL (QCAR |u|) 0) (PROGN (SPADLET |c| (QCDR |u|)) 'T)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|coercionFailure|)) (|objValUnwrap| |u'|)) ((NULL |vars|) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |u| |source|) T$)) + (|coerceInt| (mkObjWrap |u| |source|) T$)) (|coercionFailure|)) (OR (SPADLET |u'| (|coerceByFunction| |u'| |target|)) (|coercionFailure|)) @@ -3966,12 +3966,12 @@ all these coercion functions have the following result: ((AND (CONSP |u|) (EQUAL (QCAR |u|) 0) (PROGN (SPADLET |c| (QCDR |u|)) 'T)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|coercionFailure|)) (|objValUnwrap| |u'|)) ((NULL |vars|) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |u| |source|) T$)) + (|coerceInt| (mkObjWrap |u| |source|) T$)) (|coercionFailure|)) (CONS 0 (|objValUnwrap| |u'|))) ('T (SPADLET |LETTMP#1| |vars|) @@ -4093,7 +4093,7 @@ all these coercion functions have the following result: ((AND (CONSP |u|) (EQUAL (QCAR |u|) 0) (PROGN (SPADLET |c| (QCDR |u|)) 'T)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|coercionFailure|)) (|objValUnwrap| |u'|)) ('T @@ -4104,7 +4104,7 @@ all these coercion functions have the following result: (COND ((NULL (|member| |x| |vars|)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |u| |source|) T$)) + (|coerceInt| (mkObjWrap |u| |source|) T$)) (|coercionFailure|)) (CONS (CONS 0 (|objValUnwrap| |u'|)) NIL)) ('T @@ -4116,7 +4116,7 @@ all these coercion functions have the following result: (CONS |source| (CONS |$Symbol| NIL)))) (SPADLET |upU| (SPADCALL |u| |x| |univariate|)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |upU| UPP) + (|coerceInt| (mkObjWrap |upU| UPP) |target|)) (|coercionFailure|)) (|objValUnwrap| |u'|))))))))) @@ -4144,11 +4144,11 @@ all these coercion functions have the following result: (|canCoerce| D |target|)) ('T (SPADLET |num| (CAR |u|)) (SPADLET |den| (CDR |u|)) (SPADLET |num'| - (OR (|coerceInt| (|objNewWrap| |num| D) |target|) + (OR (|coerceInt| (mkObjWrap |num| D) |target|) (|coercionFailure|))) (SPADLET |num'| (|objValUnwrap| |num'|)) (SPADLET |den'| - (OR (|coerceInt| (|objNewWrap| |den| D) |target|) + (OR (|coerceInt| (mkObjWrap |den| D) |target|) (|coercionFailure|))) (SPADLET |den'| (|objValUnwrap| |den'|)) (COND @@ -4185,11 +4185,11 @@ all these coercion functions have the following result: (|canCoerce| D |target|)) ('T (SPADLET |num| (CAR |u|)) (SPADLET |den| (CDR |u|)) (SPADLET |LETTMP#1| - (OR (|coerceInt| (|objNewWrap| |num| D) |target|) + (OR (|coerceInt| (mkObjWrap |num| D) |target|) (|coercionFailure|))) (SPADLET |num'| (CDR |LETTMP#1|)) (SPADLET |LETTMP#1| - (OR (|coerceInt| (|objNewWrap| |den| D) |target|) + (OR (|coerceInt| (mkObjWrap |den| D) |target|) (|coercionFailure|))) (SPADLET |den'| (CDR |LETTMP#1|)) (QUOTIENT (TIMES (|unwrap| |num'|) 1.0) (|unwrap| |den'|)))))))) @@ -4254,7 +4254,7 @@ all these coercion functions have the following result: (|coercionFailure|)) ('T (SPADLET |num| (CAR |u|)) (SPADLET |den| (CDR |u|)) (OR (SPADLET |num'| - (|coerceInt| (|objNewWrap| |num| D) |target|)) + (|coerceInt| (mkObjWrap |num| D) |target|)) (|coercionFailure|)) (SPADLET |num'| (|objValUnwrap| |num'|)) (COND @@ -4301,7 +4301,7 @@ all these coercion functions have the following result: (QCAR |ISTMP#4|)) 'T))))))))))) (OR (SPADLET |den'| - (|coerceInt| (|objNewWrap| |den| D) T$)) + (|coerceInt| (mkObjWrap |den| D) T$)) (|coercionFailure|)) (SPADLET |den'| (CONS (|domainOne| T$) (|objValUnwrap| |den'|))) @@ -4332,10 +4332,10 @@ all these coercion functions have the following result: (|canCoerce| S |target|)) ('T (SPADLET |num| (CAR |u|)) (SPADLET |den| (CDR |u|)) (OR (SPADLET |num'| - (|coerceInt| (|objNewWrap| |num| S) |target|)) + (|coerceInt| (mkObjWrap |num| S) |target|)) (|coercionFailure|)) (OR (SPADLET |den'| - (|coerceInt| (|objNewWrap| |den| S) |target|)) + (|coerceInt| (mkObjWrap |den| S) |target|)) (|coercionFailure|)) (SPADLET |divfun| (|getFunctionFromDomain| '/ |target| @@ -4391,10 +4391,10 @@ all these coercion functions have the following result: (BOOT-EQUAL T$ '(|Polynomial| (|Integer|)))) (COND ((SPADLET |a'| - (|coerceInt| (|objNewWrap| |a| S) |target|)) + (|coerceInt| (mkObjWrap |a| S) |target|)) (COND ((SPADLET |b'| - (|coerceInt| (|objNewWrap| |b| S) + (|coerceInt| (mkObjWrap |b| S) |target|)) (SPADLET |divfunc| (|getFunctionFromDomain| '/ |target| @@ -4403,9 +4403,9 @@ all these coercion functions have the following result: (|objValUnwrap| |b'|) |divfunc|)) ('T (|coercionFailure|)))) ('T (|coercionFailure|)))) - ((SPADLET |a'| (|coerceInt| (|objNewWrap| |a| S) T$)) + ((SPADLET |a'| (|coerceInt| (mkObjWrap |a| S) T$)) (COND - ((SPADLET |b'| (|coerceInt| (|objNewWrap| |b| S) T$)) + ((SPADLET |b'| (|coerceInt| (mkObjWrap |b| S) T$)) (CONS (|objValUnwrap| |a'|) (|objValUnwrap| |b'|))) ('T (|coercionFailure|)))) ('T (|coercionFailure|))))))))) @@ -4483,7 +4483,7 @@ all these coercion functions have the following result: (COND ((BOOT-EQUAL |u| '|$fromCoerceable$|) (|canCoerce| S T$)) ((NULL (SPADLET |v| - (|coerceInt| (|objNewWrap| (CDR |u|) S) T$))) + (|coerceInt| (mkObjWrap (CDR |u|) S) T$))) (|coercionFailure|)) ('T (CONS (CAR |u|) (|objValUnwrap| |v|)))))))) @@ -4518,7 +4518,7 @@ all these coercion functions have the following result: ((NULL |u|) |u|) ((BOOT-EQUAL S T$) |u|) ((NULL (SPADLET |u'| - (|coerceInt| (|objNewWrap| |u| |source|) + (|coerceInt| (mkObjWrap |u| |source|) T$))) (SPADLET |u'| NIL) (SPADLET |zero| (|getConstantFromDomain| '(|Zero|) T$)) @@ -4537,7 +4537,7 @@ all these coercion functions have the following result: (|objValUnwrap| (OR (|coerceInt| - (|objNewWrap| |c| S) T$) + (mkObjWrap |c| S) T$) (|coercionFailure|)))) (COND ((BOOT-EQUAL |c'| |zero|) '|iterate|) @@ -4668,7 +4668,7 @@ all these coercion functions have the following result: (COND ((NULL (SPADLET |u'| (|coerceInt| - (|objNewWrap| |u| |source|) + (mkObjWrap |u| |source|) |source'|))) (|coercionFailure|)) ((NULL (SPADLET |u'| (|coerceInt| |u'| |target|))) @@ -4773,14 +4773,14 @@ all these coercion functions have the following result: 1)))) (|objValUnwrap| (|coerceInt| - (|objNew| |u| + (mkObj |u| (CONS |dmp| (CONS |vl| (CONS |$Integer| NIL)))) |target|))) ('T (OR (SPADLET |u| (|coerceInt| - (|objNewWrap| |u| |source|) S)) + (mkObjWrap |u| |source|) S)) (|coercionFailure|)) (CONS (CONS (|Zeros| |len|) (|objValUnwrap| |u|)) NIL)))))))))) @@ -4805,7 +4805,7 @@ all these coercion functions have the following result: (CONS 1 (CONS |n| (CONS (CONS 1 (CONS 0 (|domainOne| S))) NIL)))) ((QUOTE T) (OR - (SPADLET |u| (|coerceInt| (|objNewWrap| |u| |source|) S)) + (SPADLET |u| (|coerceInt| (mkObjWrap |u| |source|) S)) (|coercionFailure|)) (CONS 0 (|objValUnwrap| |u|)))))))) @@ -4859,14 +4859,14 @@ all these coercion functions have the following result: 1)))) (|objValUnwrap| (|coerceInt| - (|objNew| |u| + (mkObj |u| (CONS |ndmp| (CONS |vl| (CONS |$Integer| NIL)))) |target|))) ('T (OR (SPADLET |u| (|coerceInt| - (|objNewWrap| |u| |source|) S)) + (mkObjWrap |u| |source|) S)) (|coercionFailure|)) (CONS (CONS (|Zeros| |len|) (|objValUnwrap| |u|)) NIL)))))))))) @@ -4893,7 +4893,7 @@ all these coercion functions have the following result: (COND ((NEQUAL S |$Integer|) (SPADLET |u'| - (|coerceInt| (|objNewWrap| |u| |source|) S)) + (|coerceInt| (mkObjWrap |u| |source|) S)) (COND (|u'| (RETURN (CONS 0 (|objValUnwrap| |u'|)))) ('T NIL)))) @@ -4920,7 +4920,7 @@ all these coercion functions have the following result: ((BOOT-EQUAL |u| |x|) (CONS (CONS 1 (|domainOne| S)) NIL)) ('T (OR (SPADLET |u| - (|coerceInt| (|objNewWrap| |u| |source|) S)) + (|coerceInt| (mkObjWrap |u| |source|) S)) (|coercionFailure|)) (CONS (CONS 0 (|objValUnwrap| |u|)) NIL))))))) @@ -4990,7 +4990,7 @@ all these coercion functions have the following result: (EQL |e| 0)) (COND ((SPADLET |z| - (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|objValUnwrap| |z|)) ('T (|coercionFailure|)))) ((|member| |var| |vl|) @@ -5047,7 +5047,7 @@ all these coercion functions have the following result: NIL) (SEQ (EXIT (COND ((SPADLET |z| - (|coerceInt| (|objNewWrap| |c| S) + (|coerceInt| (mkObjWrap |c| S) |target|)) (EXIT (PROGN @@ -5122,14 +5122,14 @@ all these coercion functions have the following result: (EQL |e| 0)) (COND ((SPADLET |z| - (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|objValUnwrap| |z|)) ('T (|coercionFailure|)))) ('T (SPADLET |sym| (|objValUnwrap| (|coerceInt| - (|objNewWrap| |var| |$Symbol|) + (mkObjWrap |var| |$Symbol|) |target|))) (SPADLET |plus| (|getFunctionFromDomain| '+ |target| @@ -5147,7 +5147,7 @@ all these coercion functions have the following result: ((NULL (BOOT-EQUAL S |target|)) (COND ((NULL (SPADLET |c1| - (|coerceInt| (|objNewWrap| |c1| S) + (|coerceInt| (mkObjWrap |c1| S) |target|))) (|coercionFailure|)) ('T (SPADLET |c1| (|objValUnwrap| |c1|)))))) @@ -5179,7 +5179,7 @@ all these coercion functions have the following result: ((NULL (SPADLET |c2| (|coerceInt| - (|objNewWrap| |c2| S) |target|))) + (mkObjWrap |c2| S) |target|))) (|coercionFailure|)) ('T (SPADLET |c2| @@ -5288,12 +5288,12 @@ all these coercion functions have the following result: (EQL |e| 0)) (COND ((SPADLET |x| - (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|objValUnwrap| |x|)) ('T (|coercionFailure|)))) ((NULL (|member| |x| |vl|)) (OR (SPADLET |x| - (|coerceInt| (|objNewWrap| |u| |source|) + (|coerceInt| (mkObjWrap |u| |source|) T$)) (|coercionFailure|)) (CONS 0 (|objValUnwrap| |x|))) @@ -5322,7 +5322,7 @@ all these coercion functions have the following result: NIL) (SEQ (EXIT (PROGN (OR (SPADLET |p| - (|coerceInt| (|objNewWrap| |c| S) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|coercionFailure|)) (SPADLET |mon| @@ -5373,7 +5373,7 @@ all these coercion functions have the following result: (EQL |e| 0)) (COND ((SPADLET |x| - (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|objValUnwrap| |x|)) ('T (|coercionFailure|)))) ('T (SPADLET |pol| (|domainZero| |target|)) @@ -5399,7 +5399,7 @@ all these coercion functions have the following result: (SEQ (EXIT (COND ((SPADLET |x| (|coerceInt| - (|objNewWrap| |c| S) + (mkObjWrap |c| S) |target|)) (SPADLET |term| (SPADCALL @@ -5445,7 +5445,7 @@ all these coercion functions have the following result: ((NULL |u|) |u|) ((BOOT-EQUAL S T$) |u|) ((NULL (SPADLET |u'| - (|coerceInt| (|objNewWrap| |u| |source|) + (|coerceInt| (mkObjWrap |u| |source|) T$))) (SPADLET |u'| NIL) (SPADLET |zero| (|getConstantFromDomain| '(|Zero|) T$)) @@ -5464,7 +5464,7 @@ all these coercion functions have the following result: (|objValUnwrap| (OR (|coerceInt| - (|objNewWrap| |c| S) T$) + (mkObjWrap |c| S) T$) (|coercionFailure|)))) (COND ((BOOT-EQUAL |c'| |zero|) '|iterate|) @@ -5510,7 +5510,7 @@ all these coercion functions have the following result: 'T))) (EQL |e| 0)) (COND - ((SPADLET |x| (|coerceInt| (|objNewWrap| |c| S) |target|)) + ((SPADLET |x| (|coerceInt| (mkObjWrap |c| S) |target|)) (|objValUnwrap| |x|)) ('T (|coercionFailure|)))) ('T (|coercionFailure|))))))) @@ -5610,7 +5610,7 @@ all these coercion functions have the following result: ('T (OR (SPADLET |u| (|coerceInt| - (|objNewWrap| |u| |source|) S)) + (mkObjWrap |u| |source|) S)) (|coercionFailure|)) (CONS (CONS (|Zeros| |len|) (|objValUnwrap| |u|)) NIL)))))))))) @@ -5662,7 +5662,7 @@ all these coercion functions have the following result: ('T (OR (SPADLET |u| (|coerceInt| - (|objNewWrap| |u| |source|) S)) + (mkObjWrap |u| |source|) S)) (|coercionFailure|)) (CONS (CONS (|Zeros| |len|) (|objValUnwrap| |u|)) NIL)))))))))) @@ -5696,7 +5696,7 @@ all these coercion functions have the following result: NIL)))) ('T (OR (SPADLET |u| - (|coerceInt| (|objNewWrap| |u| |source|) S)) + (|coerceInt| (mkObjWrap |u| |source|) S)) (|coercionFailure|)) (CONS 0 (|objValUnwrap| |u|)))))))) @@ -5747,7 +5747,7 @@ all these coercion functions have the following result: ('T (OR (SPADLET |u| (|coerceInt| - (|objNewWrap| |u| |source|) S)) + (mkObjWrap |u| |source|) S)) (|coercionFailure|)) (CONS (CONS (|Zeros| |len|) (|objValUnwrap| |u|)) NIL)))))))))) @@ -5776,7 +5776,7 @@ all these coercion functions have the following result: (COND ((NEQUAL S |$Integer|) (SPADLET |u'| - (|coerceInt| (|objNewWrap| |u| |source|) S)) + (|coerceInt| (mkObjWrap |u| |source|) S)) (COND (|u'| (RETURN (CONS 0 (|objValUnwrap| |u'|)))) ('T NIL)))) @@ -5808,7 +5808,7 @@ all these coercion functions have the following result: ((BOOT-EQUAL S |$Integer|) (|coercionFailure|)) ('T (SPADLET |sym| (CADR |source|)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |u| |source|) S)) + (|coerceInt| (mkObjWrap |u| |source|) S)) (|coercionFailure|)) (CONS (|objValUnwrap| |u'|) (|getConstantFromDomain| '(|One|) S)))))))) @@ -5830,7 +5830,7 @@ all these coercion functions have the following result: ((BOOT-EQUAL |u| '|$fromCoerceable$|) 'T) ('T (OR (SPADLET |v| - (|coerceInt| (|objNewWrap| |u| |source|) + (|coerceInt| (mkObjWrap |u| |source|) (CONS '|Polynomial| (CONS S NIL)))) (|coercionFailure|)) (OR (SPADLET |v| (|coerceInt| |v| |target|)) @@ -5859,7 +5859,7 @@ all these coercion functions have the following result: (CONS (CONS 1 (|getConstantFromDomain| '(|One|) S)) NIL)) ('T (OR (SPADLET |u| - (|coerceInt| (|objNewWrap| |u| |source|) S)) + (|coerceInt| (mkObjWrap |u| |source|) S)) (|coercionFailure|)) (CONS (CONS 0 (|objValUnwrap| |u|)) NIL))))))) @@ -5884,7 +5884,7 @@ all these coercion functions have the following result: (CONS (CONS 1 (|getConstantFromDomain| '(|One|) S)) NIL)) ('T (OR (SPADLET |u| - (|coerceInt| (|objNewWrap| |u| |source|) S)) + (|coerceInt| (mkObjWrap |u| |source|) S)) (|coercionFailure|)) (CONS (CONS 0 (|objValUnwrap| |u|)) NIL))))))) @@ -5919,13 +5919,13 @@ all these coercion functions have the following result: ((BOOT-EQUAL |x| |sym|) (SPADLET |u| (|Var2Up| |u| |source| |mid|)) (OR (SPADLET |u| - (|coerceInt| (|objNewWrap| |u| |mid|) + (|coerceInt| (mkObjWrap |u| |mid|) |target|)) (|coercionFailure|)) (|objValUnwrap| |u|)) ('T (OR (SPADLET |u| - (|coerceInt| (|objNewWrap| |u| |source|) S)) + (|coerceInt| (mkObjWrap |u| |source|) S)) (|coercionFailure|)) (OR (SPADLET |u| (|coerceInt| |u| |target|)) (|coercionFailure|)) @@ -5957,7 +5957,7 @@ all these coercion functions have the following result: (|canCoerce| |mid| |target|)))) ('T (SPADLET |u| (|Var2UpS| |u| |source| |mid|)) (OR (SPADLET |u| - (|coerceInt| (|objNewWrap| |u| |mid|) |target|)) + (|coerceInt| (mkObjWrap |u| |mid|) |target|)) (|coercionFailure|)) (|objValUnwrap| |u|))))))) @@ -6022,7 +6022,7 @@ all these coercion functions have the following result: (CONS (|objValUnwrap| (|coerceInt| - (|objNewWrap| + (mkObjWrap (ELT |x| |j|) E) R)) G170807)))))))) @@ -6085,7 +6085,7 @@ all these coercion functions have the following result: (CONS (|objValUnwrap| (|coerceInt| - (|objNewWrap| + (mkObjWrap (ELT |x| |j|) E) R)) G170877)))))))) @@ -6145,7 +6145,7 @@ all these coercion functions have the following result: (CONS (|objValUnwrap| (|coerceInt| - (|objNewWrap| + (mkObjWrap (ELT |x| |j|) E) R)) G170947)))))))) @@ -6235,7 +6235,7 @@ all these coercion functions have the following result: ((NULL (AND (CONSP T$) (EQ (QCAR T$) '|Expression|))) (|coercionFailure|)) ('T (COND ((NEQUAL S '(|Float|)) (SPADLET S |$Integer|))) - (SPADLET |obj| (|objNewWrap| |u| |source|)) + (SPADLET |obj| (mkObjWrap |u| |source|)) (SPADLET E (CONS '|Expression| (CONS S NIL))) (SPADLET |newU| (|coerceInt| |obj| E)) (COND @@ -6245,12 +6245,12 @@ all these coercion functions have the following result: (|getFunctionFromDomain| '= |EQtype| (CONS E (CONS E NIL)))) (SPADLET |varE| - (|coerceInt| (|objNewWrap| |var| '(|Symbol|)) E)) + (|coerceInt| (mkObjWrap |var| '(|Symbol|)) E)) (COND ((NULL |varE|) (|coercionFailure|)) ('T (SPADLET |cenE| - (|coerceInt| (|objNewWrap| |cen| T$) E)) + (|coerceInt| (mkObjWrap |cen| T$) E)) (COND ((NULL |cenE|) (|coercionFailure|)) ('T @@ -6273,7 +6273,7 @@ all these coercion functions have the following result: ('T (SPADLET |finalObj| (|coerceInt| - (|objNewWrap| |newVal| |newType|) + (mkObjWrap |newVal| |newType|) |target|)) (COND ((NULL |finalObj|) (|coercionFailure|)) @@ -6312,14 +6312,14 @@ all these coercion functions have the following result: (AND (|canCoerce| S |target|) (|canCoerce| T$ |target|))) ('T (SPADLET |real| (CAR |u|)) (SPADLET |imag| (CDR |u|)) (OR (SPADLET |real| - (|coerceInt| (|objNewWrap| |real| S) |target|)) + (|coerceInt| (mkObjWrap |real| S) |target|)) (|coercionFailure|)) (OR (SPADLET |imag| - (|coerceInt| (|objNewWrap| |imag| S) |target|)) + (|coerceInt| (mkObjWrap |imag| S) |target|)) (|coercionFailure|)) (SPADLET |T'| (|underDomainOf| T$)) (SPADLET |i| (CONS (|domainZero| |T'|) (|domainOne| |T'|))) - (OR (SPADLET |i| (|coerceInt| (|objNewWrap| |i| T$) |target|)) + (OR (SPADLET |i| (|coerceInt| (mkObjWrap |i| T$) |target|)) (|coercionFailure|)) (SPADLET |f| (|getFunctionFromDomain| '* |target| @@ -6375,7 +6375,7 @@ all these coercion functions have the following result: (|objValUnwrap| (OR (|coerceInt| - (|objNewWrap| |x| S) + (mkObjWrap |x| S) |target|) (|coercionFailure|))) G171055)))))))) @@ -6406,7 +6406,7 @@ all these coercion functions have the following result: (CONS (OR (|coerceInt| - (|objNewWrap| + (mkObjWrap (LIST2VEC |x|) |q|) T$) (|coercionFailure|)) @@ -6489,30 +6489,30 @@ all these coercion functions have the following result: (COND ((|ofCategory| |target| '(|Field|)) (OR (SPADLET |d'| - (|coerceInt| (|objNewWrap| |d| S) |target|)) + (|coerceInt| (mkObjWrap |d| S) |target|)) (|coercionFailure|)) (SPADLET |inv| (|getFunctionFromDomain| '|inv| |target| (CONS |target| NIL))) (SPADLET |d'| (SPADCALL (|objValUnwrap| |d'|) |inv|)) (OR (SPADLET |n'| - (|coerceInt| (|objNewWrap| |n| S) |target|)) + (|coerceInt| (mkObjWrap |n| S) |target|)) (|coercionFailure|)) (SPADLET |multfunc| (|getFunctionFromDomain| '* |target| (CONS |target| (CONS |target| NIL)))) (SPADCALL |d'| (|objValUnwrap| |n'|) |multfunc|)) ('T - (OR (SPADLET |d'| (|coerceInt| (|objNewWrap| |d| S) T$)) + (OR (SPADLET |d'| (|coerceInt| (mkObjWrap |d| S) T$)) (|coercionFailure|)) (SPADLET |inv| (|getFunctionFromDomain| '|inv| T$ (CONS T$ NIL))) (SPADLET |d'| (SPADCALL (|objValUnwrap| |d'|) |inv|)) (OR (SPADLET |d'| - (|coerceInt| (|objNewWrap| |d'| T$) |target|)) + (|coerceInt| (mkObjWrap |d'| T$) |target|)) (|coercionFailure|)) (OR (SPADLET |n'| - (|coerceInt| (|objNewWrap| |n| S) |target|)) + (|coerceInt| (mkObjWrap |n| S) |target|)) (|coercionFailure|)) (SPADLET |multfunc| (|getFunctionFromDomain| '* |target| @@ -6585,13 +6585,13 @@ all these coercion functions have the following result: (OR (SPADLET |e'| (|coerceInt| - (|objNewWrap| |e| S) + (mkObjWrap |e| S) |target|)) (|coercionFailure|)) (OR (SPADLET |Eij| (|coerceInt| - (|objNewWrap| + (mkObjWrap (|makeEijSquareMatrix| |i| |j| |n|) |S'|) @@ -6718,13 +6718,13 @@ all these coercion functions have the following result: NIL) (SEQ (EXIT (PROGN (OR (SPADLET |c| - (|coerceInt| (|objNewWrap| |c| S) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|coercionFailure|)) (SPADLET |m| (SPADCALL |one| |e| |monom|)) (OR (SPADLET |m| - (|coerceInt| (|objNewWrap| |m| T$) + (|coerceInt| (mkObjWrap |m| T$) |target|)) (|coercionFailure|)) (SPADLET |c| (|objValUnwrap| |c|)) @@ -6806,7 +6806,7 @@ all these coercion functions have the following result: (CONS |source| NIL))) (SPADLET |c| (SPADCALL |u| |constfun|)) (OR (SPADLET |u'| - (|coerceInt| (|objNewWrap| |c| S) |target|)) + (|coerceInt| (mkObjWrap |c| S) |target|)) (|coercionFailure|)) (|objValUnwrap| |u'|)) ('T @@ -6819,14 +6819,14 @@ all these coercion functions have the following result: |source| (CONS |source| NIL))) (SPADLET |lc| (SPADCALL |lm| |lcfun|)) (OR (SPADLET |lc'| - (|coerceInt| (|objNewWrap| |lc| S) |target|)) + (|coerceInt| (mkObjWrap |lc| S) |target|)) (|coercionFailure|)) (SPADLET |pmfun| (|getFunctionFromDomain| '|primitiveMonomials| |source| (CONS |source| NIL))) (SPADLET |lm| (CAR (SPADCALL |lm| |pmfun|))) (OR (SPADLET |lm'| - (|coerceInt| (|objNewWrap| |lm| |source|) T$)) + (|coerceInt| (mkObjWrap |lm| |source|) T$)) (|coercionFailure|)) (OR (SPADLET |lm'| (|coerceInt| |lm'| |target|)) (|coercionFailure|)) @@ -6835,7 +6835,7 @@ all these coercion functions have the following result: (CONS |source| NIL))) (SPADLET |rd| (SPADCALL |u| |rdfun|)) (OR (SPADLET |rd'| - (|coerceInt| (|objNewWrap| |rd| |source|) + (|coerceInt| (mkObjWrap |rd| |source|) |target|)) (|coercionFailure|)) (SPADLET |lc'| (|objValUnwrap| |lc'|)) diff --git a/src/interp/i-eval.lisp.pamphlet b/src/interp/i-eval.lisp.pamphlet index 3f2e3b9..597ba76 100644 --- a/src/interp/i-eval.lisp.pamphlet +++ b/src/interp/i-eval.lisp.pamphlet @@ -791,7 +791,7 @@ (COND (|$genValue| (|wrap| (|timedEVALFUN| |form|))) ((QUOTE T) |form|))) - (|objNew| |u| |tm|))) + (mkObj |u| |tm|))) (COND ((BOOT-EQUAL |$NRTmonitorIfTrue| (QUOTE T)) (|sayBrightlyNT| @@ -812,7 +812,7 @@ (COND ((BOOT-EQUAL |x| "failed") (|stopTimingProcess| (|peekTimedName|)) - (THROW (QUOTE |interpreter|) (|objNewWrap| "failed" |$String|))) + (THROW (QUOTE |interpreter|) (mkObjWrap "failed" |$String|))) ((BOOT-EQUAL |x| |$coerceFailure|) NIL) ((QUOTE T) |x|))) diff --git a/src/interp/i-funsel.lisp.pamphlet b/src/interp/i-funsel.lisp.pamphlet index 05ddba6..067338a 100644 --- a/src/interp/i-funsel.lisp.pamphlet +++ b/src/interp/i-funsel.lisp.pamphlet @@ -2573,7 +2573,7 @@ the types A and B themselves are not sorted by preference. (setq |binVal| (COND (|$genValue| (|wrap| |fun|)) (t |fun|))) (|putValue| |op| - (|objNew| |binVal| + (mkObj |binVal| (setq |m| (CONS '|Mapping| |sig|)))) (|putModeSet| |op| (CONS |m| NIL)))))))))) @@ -4741,7 +4741,7 @@ the types A and B themselves are not sorted by preference. (COND (|cs| |arg2|) ((BOOT-EQUAL |t1| |t2|) |arg2|) - (t (setq |obj1| (|objNewWrap| |arg1| |t1|)) + (t (setq |obj1| (mkObjWrap |arg1| |t1|)) (setq |obj2| (|coerceInt| |obj1| |t2|)) (COND ((NULL |obj2|) diff --git a/src/interp/i-intern.lisp.pamphlet b/src/interp/i-intern.lisp.pamphlet index ea09722..2355bd8 100644 --- a/src/interp/i-intern.lisp.pamphlet +++ b/src/interp/i-intern.lisp.pamphlet @@ -17,7 +17,7 @@ These contain a number of slots in each node for information. The leaves are now all vectors, though the leaves for basic types such as integers and strings used to just be the objects themselves. The vectors for the leaves with such constants now have the value -of \verb|$immediateDataSymbol| as their name. Their are undoubtably still +of \verb|$immediateDataSymbol| as their name. There are undoubtably still some functions that still check whether a leaf is a constant. Note that if it is not a vector it is a subtree. @@ -44,7 +44,9 @@ slot & description\\ (SETANDFILEQ |$transferParserSrcPos| NIL) \end{chunk} + \section{Making trees} + \subsection{mkAtreeNode} \begin{chunk}{*} ;mkAtreeNode x == @@ -53,51 +55,59 @@ slot & description\\ ; v.0 := x ; v -(DEFUN |mkAtreeNode| (|x|) - (PROG (|v|) - (RETURN (PROGN (SPADLET |v| (make-array 5)) (SETELT |v| 0 |x|) |v|)))) +(defun |mkAtreeNode| (x) + (let (v) + (setq v (make-array 5)) + (setelt v 0 x) + v)) \end{chunk} + \subsection{mkAtree} Maker of attrib tree from parser form \begin{chunk}{*} ;mkAtree x == ; mkAtree1 mkAtreeExpandMacros x -(DEFUN |mkAtree| (|x|) (|mkAtree1| (|mkAtreeExpandMacros| |x|))) +(defun |mkAtree| (x) + (|mkAtree1| (|mkAtreeExpandMacros| x))) \end{chunk} + \subsection{mkAtreeWithSrcPos} \begin{chunk}{*} ;mkAtreeWithSrcPos(form, posnForm) == ; posnForm and $useParserSrcPos => pf2Atree(posnForm) ; transferSrcPosInfo(posnForm, mkAtree form) -(DEFUN |mkAtreeWithSrcPos| (|form| |posnForm|) +(defun |mkAtreeWithSrcPos| (form posnForm) (declare (special |$useParserSrcPos|)) - (COND - ((AND |posnForm| |$useParserSrcPos|) (|pf2Atree| |posnForm|)) - ((QUOTE T) (|transferSrcPosInfo| |posnForm| (|mkAtree| |form|))))) + (cond + ((and posnForm |$useParserSrcPos|) (|pf2Atree| posnForm)) + (t (|transferSrcPosInfo| posnForm (|mkAtree| form))))) \end{chunk} + \subsection{mkAtree1WithSrcPos} \begin{chunk}{*} ;mkAtree1WithSrcPos(form, posnForm) == ; transferSrcPosInfo(posnForm, mkAtree1 form) -(DEFUN |mkAtree1WithSrcPos| (|form| |posnForm|) - (|transferSrcPosInfo| |posnForm| (|mkAtree1| |form|))) +(defun |mkAtree1WithSrcPos| (form posnForm) + (|transferSrcPosInfo| posnForm (|mkAtree1| form))) \end{chunk} + \subsection{mkAtreeNodeWithSrcPos} \begin{chunk}{*} ;mkAtreeNodeWithSrcPos(form, posnForm) == ; transferSrcPosInfo(posnForm, mkAtreeNode form) -(DEFUN |mkAtreeNodeWithSrcPos| (|form| |posnForm|) - (|transferSrcPosInfo| |posnForm| (|mkAtreeNode| |form|))) +(defun |mkAtreeNodeWithSrcPos| (form posnForm) + (|transferSrcPosInfo| posnForm (|mkAtreeNode| form))) \end{chunk} + \subsection{transferSrcPosInfo} \begin{chunk}{*} ;transferSrcPosInfo(pf, atree) == @@ -113,28 +123,28 @@ Maker of attrib tree from parser form ; putSrcPos(atree, fn, pfSourceText(pf), pfLinePosn(pos), pfCharPosn(pos)) ; atree -(DEFUN |transferSrcPosInfo| (|pf| |atree|) - (PROG (|pos| |fn|) +(defun |transferSrcPosInfo| (pf atree) + (let (pos fn) (declare (special |$transferParserSrcPos|)) - (RETURN - (COND - ((NULL (AND |pf| |$transferParserSrcPos|)) |atree|) - ((QUOTE T) - (SPADLET |pos| (|pfPosOrNopos| |pf|)) - (COND - ((|pfNoPosition?| |pos|) |atree|) - ((QUOTE T) - (SPADLET |fn| (|lnPlaceOfOrigin| (|poGetLineObject| |pos|))) - (COND - ((OR (NULL |fn|) (BOOT-EQUAL |fn| "strings")) - (SPADLET |fn| "console"))) - (|putSrcPos| |atree| |fn| - (|pfSourceText| |pf|) - (|pfLinePosn| |pos|) - (|pfCharPosn| |pos|)) - |atree|))))))) + (cond + ((null (and pf |$transferParserSrcPos|)) atree) + (t + (setq pos (|pfPosOrNopos| pf)) + (cond + ((|pfNoPosition?| pos) atree) + (t + (setq fn (|lnPlaceOfOrigin| (|poGetLineObject| pos))) + (cond + ((or (null fn) (string= fn "strings")) + (setq fn "console"))) + (|putSrcPos| atree fn + (|pfSourceText| pf) + (|pfLinePosn| pos) + (|pfCharPosn| pos)) + atree)))))) \end{chunk} + \subsection{mkAtreeExpandMacros} Handle macro expansion. if the macros have args we require that we match the correct number of args @@ -163,89 +173,79 @@ we match the correct number of args ; x := [mkAtreeExpandMacros op,:argl] ; x -(DEFUN |mkAtreeExpandMacros| (|x|) - (PROG (|ISTMP#2| |op| |before| |ISTMP#1| |after| |argl| |m| - |args| |body| |sl|) - (RETURN - (SEQ - (PROGN - (COND - ((AND - (NULL (AND (CONSP |x|) (EQ (QCAR |x|) (QUOTE MDEF)))) - (NULL - (AND (CONSP |x|) - (EQ (QCAR |x|) (QUOTE DEF)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (CONSP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQ (QCAR |ISTMP#2|) (QUOTE |macro|))))))))) - (COND - ((AND (ATOM |x|) (SPADLET |m| (|isInterpMacro| |x|))) - (SPADLET |args| (CAR |m|)) - (SPADLET |body| (CDR |m|)) - (COND (|args| (QUOTE |doNothing|)) ((QUOTE T) (SPADLET |x| |body|)))) - ((AND (CONSP |x|) - (PROGN - (SPADLET |op| (QCAR |x|)) - (SPADLET |argl| (QCDR |x|)) - (QUOTE T))) - (COND - ((BOOT-EQUAL |op| (QUOTE QUOTE)) (QUOTE |doNothing|)) - ((AND (BOOT-EQUAL |op| (QUOTE |where|)) - (CONSP |argl|) - (PROGN - (SPADLET |before| (QCAR |argl|)) - (SPADLET |ISTMP#1| (QCDR |argl|)) - (AND - (CONSP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |after| (QCAR |ISTMP#1|)) (QUOTE T))))) - (SPADLET |x| - (CONS |op| - (CONS |before| - (CONS (|mkAtreeExpandMacros| |after|) NIL))))) - ((QUOTE T) - (SPADLET |argl| - (PROG (#0=#:G166116) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166121 |argl| (CDR #1#)) (|a| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |a| (CAR #1#)) NIL)) - (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# (CONS (|mkAtreeExpandMacros| |a|) #0#)))))))) - (COND - ((SPADLET |m| (|isInterpMacro| |op|)) - (SPADLET |args| (CAR |m|)) - (SPADLET |body| (CDR |m|)) - (COND - ((BOOT-EQUAL (|#| |args|) (|#| |argl|)) - (SPADLET |sl| - (PROG (#2=#:G166132) - (SPADLET #2# NIL) - (RETURN - (DO ((#3=#:G166138 |args| (CDR #3#)) - (|a| NIL) - (#4=#:G166139 |argl| (CDR #4#)) - (|s| NIL)) - ((OR (ATOM #3#) - (PROGN (SETQ |a| (CAR #3#)) NIL) - (ATOM #4#) - (PROGN (SETQ |s| (CAR #4#)) NIL)) - (NREVERSE0 #2#)) - (SEQ (EXIT (SETQ #2# (CONS (CONS |a| |s|) #2#)))))))) - (SPADLET |x| (SUBLISNQ |sl| |body|))) - ((NULL |args|) (SPADLET |x| (CONS |body| |argl|))) - ((QUOTE T) (SPADLET |x| (CONS |op| |argl|))))) - ((QUOTE T) - (SPADLET |x| (CONS (|mkAtreeExpandMacros| |op|) |argl|)))))))))) - |x|))))) +(defun |mkAtreeExpandMacros| (x) + (let (tmp1 op before after argl m args body sl) + (cond + ((and + (null (and (consp x) (eq (qcar x) (quote mdef)))) + (null + (and (consp x) + (eq (qcar x) (quote def)) + (progn + (and + (consp (qcdr x)) + (progn + (and + (consp (qcar (qcdr x))) + (eq (qcar (qcar (qcdr x))) '|macro|)))))))) + (cond + ((and (atom x) (setq m (|isInterpMacro| x))) + (setq args (car m)) + (setq body (cdr m)) + (cond (args '|doNothing|) (t (setq x body)))) + ((and (consp x) + (progn + (setq op (qcar x)) + (setq argl (qcdr x)) + t)) + (cond + ((boot-equal op 'quote) '|doNothing|) + ((and (boot-equal op '|where|) + (consp argl) + (progn + (setq before (qcar argl)) + (setq tmp1 (qcdr argl)) + (and + (consp tmp1) + (eq (qcdr tmp1) nil) + (progn (setq after (qcar tmp1)) t)))) + (setq x + (cons op + (cons before + (cons (|mkAtreeExpandMacros| after) nil))))) + (t + (setq argl + (let (g0) + (do ((g1 argl (cdr g1)) (a nil)) + ((or (atom g1) (progn (setq a (car g1)) nil)) + (nreverse0 g0)) + (seq + (exit + (setq g0 (cons (|mkAtreeExpandMacros| a) g0))))))) + (cond + ((setq m (|isInterpMacro| op)) + (setq args (car m)) + (setq body (cdr m)) + (cond + ((= (|#| args) (|#| argl)) + (setq sl + (let (g2) + (do ((g3 args (cdr g3)) + (a nil) + (g4 argl (cdr g4)) + (s nil)) + ((or (atom g3) + (progn (setq a (car g3)) nil) + (atom g4) + (progn (setq s (car g4)) nil)) + (nreverse0 g2)) + (seq (exit (setq g2 (cons (cons a s) g2))))))) + (setq x (sublisnq sl body))) + ((null args) (setq x (cons body argl))) + (t (setq x (cons op argl))))) + (t + (setq x (cons (|mkAtreeExpandMacros| op) argl)))))))))) + x)) \end{chunk} \subsection{mkAtree1} @@ -272,37 +272,31 @@ we match the correct number of args ; x is [op,:argl] => mkAtree2(x,op,argl) ; systemErrorHere '"mkAtree1" -(DEFUN |mkAtree1| (|x|) - (PROG (|tree| |v| |op| |argl|) +(defun |mkAtree1| (x) + (let (tree v) (declare (special |$immediateDataSymbol| |$Void|)) - (RETURN - (COND - ((NULL |x|) - (|throwKeyedMsg| (QUOTE S2IP0005) (CONS "NIL" NIL))) - ((VECP |x|) |x|) - ((ATOM |x|) - (COND - ((|member| |x| (QUOTE (|noBranch| |noMapVal|))) |x|) - ((|member| |x| (QUOTE (|nil| |true| |false|))) - (|mkAtree2| (CONS |x| NIL) |x| NIL)) - ((BOOT-EQUAL |x| (QUOTE |/throwAway|)) - (SPADLET |tree| (|mkAtree1| (QUOTE (|void|)))) - (|putValue| |tree| (|objNewWrap| (|voidValue|) |$Void|)) - (|putModeSet| |tree| (CONS |$Void| NIL)) |tree|) - ((|getBasicMode| |x|) - (SPADLET |v| (|mkAtreeNode| |$immediateDataSymbol|)) - (|putValue| |v| (|getBasicObject| |x|)) |v|) - ((IDENTP |x|) (|mkAtreeNode| |x|)) - ((QUOTE T) (|keyedSystemError| (QUOTE S2II0002) (CONS |x| NIL))))) - ((AND (CONSP |x|) - (PROGN - (SPADLET |op| (QCAR |x|)) - (SPADLET |argl| (QCDR |x|)) - (QUOTE T))) - (|mkAtree2| |x| |op| |argl|)) - ((QUOTE T) (|systemErrorHere| "mkAtree1")))))) + (cond + ((null x) (|throwKeyedMsg| 'S2IP0005 (cons "NIL" nil))) + ((vecp x) x) + ((atom x) + (cond + ((|member| x '(|noBranch| |noMapVal|)) x) + ((|member| x '(|nil| |true| |false|)) + (|mkAtree2| (cons x nil) x nil)) + ((eq x '|/throwAway|) + (setq tree (|mkAtree1| '(|void|))) + (|putValue| tree (mkObjWrap (|voidValue|) |$Void|)) + (|putModeSet| tree (cons |$Void| nil)) tree) + ((|getBasicMode| x) + (setq v (|mkAtreeNode| |$immediateDataSymbol|)) + (|putValue| v (|getBasicObject| x)) v) + ((identp x) (|mkAtreeNode| x)) + (t (|keyedSystemError| 'S2II0002 (cons x nil))))) + ((consp x) (|mkAtree2| x (qcar x) (qcdr x))) + (t (|systemErrorHere| "mkAtree1"))))) \end{chunk} + \subsection{mkAtree2} mkAtree2 and mkAtree3 were created because mkAtree1 got so big \begin{chunk}{*} @@ -375,267 +369,259 @@ mkAtree2 and mkAtree3 were created because mkAtree1 got so big ; '"not qualifying an operator"]) ; mkAtree3(x,op,argl) -(DEFUN |mkAtree2| (|x| |op| |argl|) - (PROG (|nargl| |y| |val| |z| |expr| |type| |args| |ISTMP#3| |ISTMP#4| - |rhs| |ISTMP#2| |op1| |a'| D |ISTMP#1| |a| |t| |v|) +(defun |mkAtree2| (x op argl) + (let (nargl y val z expr type args tmp3 tmp4 rhs tmp2 op1 ap D tmp1 a tt v) (declare (special |$elt| |$immediateDataSymbol| |$NoValue|)) - (RETURN - (SEQ - (PROGN - (SPADLET |nargl| (|#| |argl|)) - (COND - ((AND (BOOT-EQUAL |op| (QUOTE -)) - (EQL |nargl| 1) - (INTEGERP (CAR |argl|))) - (|mkAtree1| (MINUS (CAR |argl|)))) - ((AND (BOOT-EQUAL |op| (QUOTE |:|)) - (CONSP |argl|) - (PROGN - (SPADLET |y| (QCAR |argl|)) - (SPADLET |ISTMP#1| (QCDR |argl|)) - (AND - (CONSP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |z| (QCAR |ISTMP#1|)) (QUOTE T))))) - (CONS (|mkAtreeNode| (QUOTE |Declare|)) |argl|)) - ((BOOT-EQUAL |op| (QUOTE COLLECT)) - (CONS (|mkAtreeNode| |op|) (|transformCollect| |argl|))) - ((BOOT-EQUAL |op| (QUOTE |break|)) - (COND - ((AND (CONSP |argl|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |argl|)) - (AND - (CONSP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |val| (QCAR |ISTMP#1|)) (QUOTE T))))) - (COND - ((BOOT-EQUAL |val| (QUOTE |$NoValue|)) - (SPADLET |val| (QUOTE (|void|))))) - (CONS (|mkAtreeNode| |op|) (CONS (|mkAtree1| |val|) NIL))) - ((QUOTE T) - (CONS - (|mkAtreeNode| |op|) - (CONS (|mkAtree1| (QUOTE (|void|))) NIL))))) - ((BOOT-EQUAL |op| (QUOTE |return|)) - (COND - ((AND (CONSP |argl|) - (EQ (QCDR |argl|) NIL) - (PROGN (SPADLET |val| (QCAR |argl|)) (QUOTE T))) - (COND - ((BOOT-EQUAL |val| (QUOTE |$NoValue|)) - (SPADLET |val| (QUOTE (|void|))))) - (CONS (|mkAtreeNode| |op|) (CONS (|mkAtree1| |val|) NIL))) - ((QUOTE T) - (CONS - (|mkAtreeNode| |op|) - (CONS (|mkAtree1| (QUOTE (|void|))) NIL))))) - ((BOOT-EQUAL |op| (QUOTE |exit|)) (|mkAtree1| (CADR |argl|))) - ((BOOT-EQUAL |op| (QUOTE QUOTE)) (CONS (|mkAtreeNode| |op|) |argl|)) - ((BOOT-EQUAL |op| (QUOTE SEGMENT)) - (COND - ((AND (CONSP |argl|) - (EQ (QCDR |argl|) NIL) - (PROGN (SPADLET |a| (QCAR |argl|)) (QUOTE T))) - (CONS (|mkAtreeNode| |op|) (CONS (|mkAtree1| |a|) NIL))) - ((QUOTE T) - (SPADLET |z| - (COND - ((NULL (ELT |argl| 1)) NIL) - ((QUOTE T) (|mkAtree1| (ELT |argl| 1))))) - (CONS - (|mkAtreeNode| |op|) - (CONS (|mkAtree1| (ELT |argl| 0)) (CONS |z| NIL)))))) - ((|member| |op| (QUOTE (|pretend| |is| |isnt|))) - (CONS - (|mkAtreeNode| |op|) - (CONS (|mkAtree1| (CAR |argl|)) (CDR |argl|)))) - ((BOOT-EQUAL |op| (QUOTE |::|)) - (CONS - (|mkAtreeNode| (QUOTE COERCE)) - (CONS (|mkAtree1| (CAR |argl|)) (CONS (CADR |argl|) NIL)))) - ((AND (CONSP |x|) - (EQ (QCAR |x|) (QUOTE @)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (CONSP |ISTMP#1|) - (PROGN - (SPADLET |expr| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |type| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (SPADLET |t| (|evaluateType| (|unabbrev| |type|))) - (COND - ((AND - (BOOT-EQUAL |t| (QUOTE (|DoubleFloat|))) - (CONSP |expr|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |expr|)) - (AND - (CONSP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) (QUOTE |$elt|)) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQUAL (QCAR |ISTMP#2|) (QUOTE (|Float|))) - (PROGN - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (CONSP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (EQ (QCAR |ISTMP#3|) (QUOTE |float|)))))))) - (PROGN (SPADLET |args| (QCDR |expr|)) (QUOTE T))) - (|mkAtree1| - (CONS - (CONS - (QUOTE |$elt|) - (CONS (QUOTE (|DoubleFloat|)) (CONS (QUOTE |float|) NIL))) - |args|))) - ((AND (BOOT-EQUAL |t| (QUOTE (|DoubleFloat|))) (INTEGERP |expr|)) - (SPADLET |v| (|mkAtreeNode| |$immediateDataSymbol|)) - (|putValue| |v| (|getBasicObject| (|float| |expr|))) - |v|) - ((AND (BOOT-EQUAL |t| (QUOTE (|Float|))) (INTEGERP |expr|)) - (|mkAtree1| (CONS (QUOTE |::|) (CONS |expr| (CONS |t| NIL))))) - ((AND (|typeIsASmallInteger| |t|) (INTEGERP |expr|)) - (|mkAtree1| (CONS (QUOTE |::|) (CONS |expr| (CONS |t| NIL))))) - ((QUOTE T) - (CONS - (|mkAtreeNode| (QUOTE TARGET)) - (CONS (|mkAtree1| |expr|) (CONS |type| NIL)))))) - ((AND (BOOT-EQUAL |op| (QUOTE |case|)) (EQL |nargl| 2)) - (CONS - (|mkAtreeNode| (QUOTE |case|)) - (CONS - (|mkAtree1| (CAR |argl|)) - (CONS (|unabbrev| (CADR |argl|)) NIL)))) - ((BOOT-EQUAL |op| (QUOTE REPEAT)) - (CONS (|mkAtreeNode| |op|) (|transformREPEAT| |argl|))) - ((AND - (BOOT-EQUAL |op| (QUOTE LET)) - (CONSP |argl|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |argl|)) - (AND (CONSP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |construct|)))) - (PROGN - (SPADLET |ISTMP#2| (QCDR |argl|)) - (AND (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |rhs| (QCAR |ISTMP#2|)) (QUOTE T))))) - (CONS - (|mkAtreeNode| (QUOTE LET)) - (CONS (CAR |argl|) (CONS (|mkAtree1| |rhs|) NIL)))) - ((AND - (BOOT-EQUAL |op| (QUOTE LET)) - (CONSP |argl|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |argl|)) - (AND - (CONSP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) (QUOTE |:|)) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (PROGN - (SPADLET |a| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND (CONSP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL))))))) - (PROGN - (SPADLET |ISTMP#4| (QCDR |argl|)) - (AND - (CONSP |ISTMP#4|) - (EQ (QCDR |ISTMP#4|) NIL) - (PROGN (SPADLET |rhs| (QCAR |ISTMP#4|)) (QUOTE T))))) - (|mkAtree1| - (CONS - (QUOTE SEQ) - (CONS - (CAR |argl|) - (CONS (CONS (QUOTE LET) (CONS |a| (CONS |rhs| NIL))) NIL))))) - ((AND (CONSP |op|) - (EQ (QCAR |op|) (QUOTE |$elt|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |op|)) - (AND - (CONSP |ISTMP#1|) - (PROGN - (SPADLET D (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |op1| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (COND - ((EQ |op1| (QUOTE =)) - (SPADLET |a'| - (CONS - (|mkAtreeNode| (QUOTE =)) - (PROG (#0=#:G166300) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166305 |argl| (CDR #1#)) (|arg| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |arg| (CAR #1#)) NIL)) - (NREVERSE0 #0#)) - (SEQ (EXIT (SETQ #0# (CONS (|mkAtree1| |arg|) #0#))))))))) - (CONS (|mkAtreeNode| (QUOTE |Dollar|)) (CONS D (CONS |a'| NIL)))) - ((QUOTE T) - (CONS - (|mkAtreeNode| (QUOTE |Dollar|)) - (CONS D (CONS (|mkAtree1| (CONS |op1| |argl|)) NIL)))))) - ((BOOT-EQUAL |op| (QUOTE |$elt|)) - (COND - ((AND (CONSP |argl|) - (PROGN - (SPADLET D (QCAR |argl|)) - (SPADLET |ISTMP#1| (QCDR |argl|)) - (AND - (CONSP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (QUOTE T))))) - (COND - ((INTEGERP |a|) - (COND - ((EQL |a| 0) - (|mkAtree1| - (CONS - (CONS (QUOTE |$elt|) (CONS D (CONS (QUOTE |Zero|) NIL))) - NIL))) - ((EQL |a| 1) - (|mkAtree1| - (CONS - (CONS (QUOTE |$elt|) (CONS D (CONS (QUOTE |One|) NIL))) - NIL))) - ((QUOTE T) - (SPADLET |t| (|evaluateType| (|unabbrev| (CONS D NIL)))) - (COND - ((AND (|typeIsASmallInteger| |t|) (typep |a| 'fixnum)) - (SPADLET |v| (|mkAtreeNode| |$immediateDataSymbol|)) - (|putValue| |v| (|mkObjWrap| |a| |t|)) |v|) - ((QUOTE T) - (|mkAtree1| - (CONS - (QUOTE *) - (CONS |a| - (CONS - (CONS - (CONS (QUOTE |$elt|) (CONS D (CONS (QUOTE |One|) NIL))) - NIL) - NIL))))))))) - ((QUOTE T) - (CONS - (|mkAtreeNode| (QUOTE |Dollar|)) - (CONS D (CONS (|mkAtree1| |a|) NIL)))))) - ((QUOTE T) - (|keyedSystemError| (QUOTE S2II0003) - (CONS "$" (CONS |argl| (CONS "not qualifying an operator" NIL))))))) - ((QUOTE T) (|mkAtree3| |x| |op| |argl|)))))))) + (setq nargl (|#| argl)) + (cond + ((and (eq op '-) + (eql nargl 1) + (integerp (car argl))) + (|mkAtree1| (minus (car argl)))) + ((and (eq op '|:|) + (consp argl) + (progn + (setq y (qcar argl)) + (and + (consp (qcdr argl)) + (eq (qcdr (qcdr argl)) nil) + (progn (setq z (qcar (qcdr argl))) t)))) + (cons (|mkAtreeNode| '|Declare|) argl)) + ((eq op 'collect) + (cons (|mkAtreeNode| op) (|transformCollect| argl))) + ((eq op '|break|) + (cond + ((and (consp argl) + (progn + (setq tmp1 (qcdr argl)) + (and + (consp tmp1) + (eq (qcdr tmp1) nil) + (progn (setq val (qcar tmp1)) t)))) + (cond + ((eq val '|$NoValue|) + (setq val '(|void|)))) + (cons (|mkAtreeNode| op) (cons (|mkAtree1| val) nil))) + (t + (cons + (|mkAtreeNode| op) + (cons (|mkAtree1| '(|void|)) nil))))) + ((eq op '|return|) + (cond + ((and (consp argl) + (eq (qcdr argl) nil) + (progn (setq val (qcar argl)) t)) + (cond + ((eq val '|$NoValue|) + (setq val '(|void|)))) + (cons (|mkAtreeNode| op) (cons (|mkAtree1| val) nil))) + (t + (cons + (|mkAtreeNode| op) + (cons (|mkAtree1| '(|void|)) nil))))) + ((eq op '|exit|) (|mkAtree1| (cadr argl))) + ((eq op 'quote) (cons (|mkAtreeNode| op) argl)) + ((eq op 'segment) + (cond + ((and (consp argl) + (eq (qcdr argl) nil) + (progn (setq a (qcar argl)) t)) + (cons (|mkAtreeNode| op) (cons (|mkAtree1| a) nil))) + (t + (setq z + (cond + ((null (elt argl 1)) nil) + (t (|mkAtree1| (elt argl 1))))) + (cons + (|mkAtreeNode| op) + (cons (|mkAtree1| (elt argl 0)) (cons z nil)))))) + ((|member| op '(|pretend| |is| |isnt|)) + (cons + (|mkAtreeNode| op) + (cons (|mkAtree1| (car argl)) (cdr argl)))) + ((eq op '|::|) + (cons + (|mkAtreeNode| 'coerce) + (cons (|mkAtree1| (car argl)) (cons (cadr argl) nil)))) + ((and (consp x) + (eq (qcar x) '@) + (progn + (setq tmp1 (qcdr x)) + (and + (consp tmp1) + (progn + (setq expr (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (eq (qcdr tmp2) nil) + (progn (setq type (qcar tmp2)) t)))))) + (setq tt (|evaluateType| (|unabbrev| type))) + (cond + ((and + (eq tt '(|DoubleFloat|)) + (consp expr) + (progn + (setq tmp1 (qcar expr)) + (and + (consp tmp1) + (eq (qcar tmp1) '|$elt|) + (progn + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (equal (qcar tmp2) '(|Float|)) + (progn + (setq tmp3 (qcdr tmp2)) + (and + (consp tmp3) + (eq (qcdr tmp3) nil) + (eq (qcar tmp3) '|float|))))))) + (progn (setq args (qcdr expr)) t)) + (|mkAtree1| + (cons + (cons + '|$elt| + (cons '(|DoubleFloat|) (cons '|float| nil))) + args))) + ((and (eq tt '(|DoubleFloat|)) (integerp expr)) + (setq v (|mkAtreeNode| |$immediateDataSymbol|)) + (|putValue| v (|getBasicObject| (|float| expr))) + v) + ((and (eq tt '(|Float|)) (integerp expr)) + (|mkAtree1| (cons '|::| (cons expr (cons tt nil))))) + ((and (|typeIsASmallInteger| tt) (integerp expr)) + (|mkAtree1| (cons '|::| (cons expr (cons tt nil))))) + (t + (cons + (|mkAtreeNode| 'target) + (cons (|mkAtree1| expr) (cons type nil)))))) + ((and (eq op '|case|) (eql nargl 2)) + (cons + (|mkAtreeNode| '|case|) + (cons + (|mkAtree1| (car argl)) + (cons (|unabbrev| (cadr argl)) nil)))) + ((eq op 'repeat) + (cons (|mkAtreeNode| op) (|transformREPEAT| argl))) + ((AND + (eq op 'let) + (consp argl) + (progn + (setq tmp1 (QCAR argl)) + (and (consp tmp1) (eq (qcar tmp1) '|construct|))) + (progn + (setq tmp2 (qcdr argl)) + (and (consp tmp2) + (eq (qcdr tmp2) nil) + (progn (setq rhs (qcar tmp2)) t)))) + (cons + (|mkAtreeNode| 'let) + (cons (car argl) (cons (|mkAtree1| rhs) nil)))) + ((and + (eq op 'let) + (consp argl) + (progn + (setq tmp1 (qcar argl)) + (and + (consp tmp1) + (eq (qcar tmp1) '|:|) + (progn + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (progn + (setq a (qcar tmp2)) + (setq tmp3 (qcdr tmp2)) + (and (consp tmp3) (eq (qcdr tmp3) nil))))))) + (progn + (setq tmp4 (qcdr argl)) + (and + (consp tmp4) + (eq (qcdr tmp4) nil) + (progn (setq rhs (qcar tmp4)) t)))) + (|mkAtree1| + (cons 'seq + (cons + (car argl) + (cons (cons 'let (cons a (cons rhs nil))) nil))))) + ((and (consp op) + (eq (qcar op) '|$elt|) + (progn + (setq tmp1 (qcdr op)) + (and + (consp tmp1) + (progn + (setq d (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (eq (qcdr tmp2) nil) + (progn (setq op1 (qcar tmp2)) t)))))) + (cond + ((eq op1 '=) + (setq ap + (cons + (|mkAtreeNode| '=) + (let (g0) + (do ((g1 argl (cdr g1)) (arg nil)) + ((or (atom g1) (progn (setq arg (car g1)) nil)) + (nreverse0 g0)) + (seq (exit (setq g0 (cons (|mkAtree1| arg) g0)))))))) + (cons (|mkAtreeNode| '|Dollar|) (cons d (cons ap nil)))) + (t + (cons + (|mkAtreeNode| '|Dollar|) + (cons d (cons (|mkAtree1| (cons op1 argl)) nil)))))) + ((eq op '|$elt|) + (cond + ((and (consp argl) + (progn + (setq d (qcar argl)) + (setq tmp1 (qcdr argl)) + (and + (consp tmp1) + (eq (qcdr tmp1) nil) + (progn (setq a (qcar tmp1)) t)))) + (cond + ((integerp a) + (cond + ((eql a 0) + (|mkAtree1| + (cons + (cons '|$elt| (cons d (cons '|Zero| nil))) + nil))) + ((eql a 1) + (|mkAtree1| + (cons + (cons '|$elt| (cons d (cons '|One| nil))) + nil))) + (t + (setq tt (|evaluateType| (|unabbrev| (cons d nil)))) + (cond + ((and (|typeIsASmallInteger| tt) (typep a 'fixnum)) + (setq v (|mkAtreeNode| |$immediateDataSymbol|)) + (|putValue| v (mkObjWrap a tt)) v) + (t + (|mkAtree1| + (cons '* + (cons a + (cons + (cons + (cons '|$elt| (cons d (cons '|One| nil))) + nil) + nil))))))))) + (t + (cons + (|mkAtreeNode| '|Dollar|) + (cons d (cons (|mkAtree1| a) nil)))))) + (t + (|keyedSystemError| 'S2II0003 + (cons "$" (cons argl (cons "not qualifying an operator" nil))))))) + (t (|mkAtree3| x op argl))))) \end{chunk} + \subsection{mkAtree3} mkAtree2 and mkAtree3 were created because mkAtree1 got so big \begin{chunk}{*} @@ -726,394 +712,379 @@ mkAtree2 and mkAtree3 were created because mkAtree1 got so big ; mkAtree1 op ; [z,:[mkAtree1 y for y in argl]] -(DEFUN |mkAtree3,fn| (|a| |b|) - (SEQ - (IF (AND |a| |b|) - (EXIT - (IF (BOOT-EQUAL |a| |b|) - |a| +(defun |mkAtree3,fn| (a b) + (seq + (if (and a b) + (exit + (if (equal a b) + a (|throwMessage| " double declaration of parameter")))) - (EXIT (OR |a| |b|)))) + (exit (or a b)))) -(DEFUN |mkAtree3| (|x| |op| |argl|) - (PROG (|op1| |axis| |lhs| |rhs| |var| |lb| |ul| |upTest| |lowTest| |p| - |sym| |junk1| |junk2| |val| |b| |funargs| |type| |funbody| - |before| |after| |ISTMP#2| |ISTMP#3| |form| |ISTMP#4| |ISTMP#5| - |ISTMP#6| |body| |ISTMP#1| |a| |arg| |types| |r'| |at| |r| |v| |z|) +(defun |mkAtree3| (x op argl) + (let (op1 axis lhs rhs var lb ul upTest lowTest p sym junk1 junk2 val b + funargs type funbody before after tmp2 tmp3 form tmp4 tmp5 tmp6 + body tmp1 a arg types rp at r v z) (declare (special |$immediateDataSymbol|)) - (RETURN - (SEQ - (COND - ((AND (BOOT-EQUAL |op| (QUOTE REDUCE)) - (CONSP |argl|) - (PROGN - (SPADLET |op1| (QCAR |argl|)) - (SPADLET |ISTMP#1| (QCDR |argl|)) - (AND - (CONSP |ISTMP#1|) - (PROGN - (SPADLET |axis| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |body| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (CONS - (|mkAtreeNode| |op|) - (CONS |axis| (CONS (|mkAtree1| |op1|) (CONS (|mkAtree1| |body|) NIL))))) - ((BOOT-EQUAL |op| (QUOTE |has|)) (CONS (|mkAtreeNode| |op|) |argl|)) - ((BOOT-EQUAL |op| (QUOTE |\||)) - (CONS - (|mkAtreeNode| (QUOTE |AlgExtension|)) - (PROG (#0=#:G166691) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166696 |argl| (CDR #1#)) (|arg| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |arg| (CAR #1#)) NIL)) - (NREVERSE0 #0#)) - (SEQ (EXIT (SETQ #0# (CONS (|mkAtree1| |arg|) #0#))))))))) - ((BOOT-EQUAL |op| (QUOTE =)) - (CONS - (|mkAtreeNode| (QUOTE |equation|)) - (PROG (#2=#:G166706) - (SPADLET #2# NIL) - (RETURN - (DO ((#3=#:G166711 |argl| (CDR #3#)) (|arg| NIL)) - ((OR (ATOM #3#) (PROGN (SETQ |arg| (CAR #3#)) NIL)) - (NREVERSE0 #2#)) - (SEQ (EXIT (SETQ #2# (CONS (|mkAtree1| |arg|) #2#))))))))) - ((AND (BOOT-EQUAL |op| (QUOTE |not|)) - (CONSP |argl|) - (EQ (QCDR |argl|) NIL) - (PROGN - (SPADLET |ISTMP#1| (QCAR |argl|)) - (AND - (CONSP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) (QUOTE =)) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (PROGN - (SPADLET |lhs| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (CONSP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (PROGN (SPADLET |rhs| (QCAR |ISTMP#3|)) (QUOTE T))))))))) - (CONS - (|mkAtreeNode| (QUOTE |not|)) - (CONS - (CONS - (|mkAtreeNode| (QUOTE =)) - (CONS (|mkAtree1| |lhs|) (CONS (|mkAtree1| |rhs|) NIL))) - NIL))) - ((AND (BOOT-EQUAL |op| (QUOTE |in|)) - (CONSP |argl|) - (PROGN - (SPADLET |var| (QCAR |argl|)) - (SPADLET |ISTMP#1| (QCDR |argl|)) - (AND - (CONSP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQ (QCAR |ISTMP#2|) (QUOTE SEGMENT)) - (PROGN - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (CONSP |ISTMP#3|) - (PROGN - (SPADLET |lb| (QCAR |ISTMP#3|)) - (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) - (AND - (CONSP |ISTMP#4|) - (EQ (QCDR |ISTMP#4|) NIL) - (PROGN (SPADLET |ul| (QCAR |ISTMP#4|)) (QUOTE T))))))))))) - (SPADLET |upTest| - (COND - ((NULL |ul|) NIL) - ((QUOTE T) (|mkLessOrEqual| |var| |ul|)))) - (SPADLET |lowTest| (|mkLessOrEqual| |lb| |var|)) - (SPADLET |z| - (COND - (|ul| (CONS (QUOTE |and|) (CONS |lowTest| (CONS |upTest| NIL)))) - ((QUOTE T) |lowTest|))) - (|mkAtree1| |z|)) - ((AND (CONSP |x|) - (EQ (QCAR |x|) (QUOTE IF)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (CONSP |ISTMP#1|) - (PROGN - (SPADLET |p| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQ (QCAR |ISTMP#2|) (QUOTE |noBranch|)) - (PROGN - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (CONSP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (PROGN (SPADLET |a| (QCAR |ISTMP#3|)) (QUOTE T))))))))) + (cond + ((and (eq op 'reduce) + (consp argl) + (progn + (setq op1 (qcar argl)) + (setq tmp1 (qcdr argl)) + (and + (consp tmp1) + (progn + (setq axis (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (eq (qcdr tmp2) nil) + (progn (setq body (qcar tmp2)) t)))))) + (cons + (|mkAtreeNode| op) + (cons axis (cons (|mkAtree1| op1) (cons (|mkAtree1| body) nil))))) + ((eq op '|has|) (cons (|mkAtreeNode| op) argl)) + ((eq op '|\||) + (cons + (|mkAtreeNode| '|AlgExtension|) + (let (g0) + (do ((g1 argl (cdr g1)) (arg nil)) + ((or (atom g1) (progn (setq arg (car g1)) nil)) + (nreverse0 g0)) + (setq g0 (cons (|mkAtree1| arg) g0)))))) + ((eq op '=) + (cons + (|mkAtreeNode| '|equation|) + (let (g2) + (do ((g3 argl (cdr g3)) (arg nil)) + ((or (atom g3) (progn (setq arg (car g3)) nil)) + (nreverse0 g2)) + (setq g2 (cons (|mkAtree1| arg) g2)))))) + ((and (eq op '|not|) + (consp argl) + (eq (qcdr argl) nil) + (progn + (setq tmp1 (qcar argl)) + (and + (consp tmp1) + (eq (qcar tmp1) '=) + (progn + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (progn + (setq lhs (qcar tmp2)) + (setq tmp3 (qcdr tmp2)) + (and + (consp tmp3) + (eq (qcdr tmp3) nil) + (progn (setq rhs (qcar tmp3)) t)))))))) + (cons + (|mkAtreeNode| '|not|) + (cons + (cons + (|mkAtreeNode| '=) + (cons (|mkAtree1| lhs) (cons (|mkAtree1| rhs) nil))) + nil))) + ((and (eq op '|in|) + (consp argl) + (progn + (setq var (qcar argl)) + (setq tmp1 (qcdr argl)) + (and + (consp tmp1) + (eq (qcdr tmp1) nil) + (progn + (setq tmp2 (qcar tmp1)) + (and + (consp tmp2) + (eq (qcar tmp2) 'segment) + (progn + (setq tmp3 (qcdr tmp2)) + (and + (consp tmp3) + (progn + (setq lb (qcar tmp3)) + (setq tmp4 (qcdr tmp3)) + (and + (consp tmp4) + (eq (qcdr tmp4) nil) + (progn (setq ul (qcar tmp4)) t)))))))))) + (setq upTest + (cond + ((null ul) nil) + (t (|mkLessOrEqual| var ul)))) + (setq lowTest (|mkLessOrEqual| lb var)) + (setq z + (cond + (ul (cons '|and| (cons lowTest (cons upTest nil)))) + (t lowTest))) + (|mkAtree1| z)) + ((and (consp x) + (eq (qcar x) 'if) + (progn + (setq tmp1 (qcdr x)) + (and + (consp tmp1) + (progn + (setq p (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (eq (qcar tmp2) '|noBranch|) + (progn + (setq tmp3 (qcdr tmp2)) + (and + (consp tmp3) + (eq (qcdr tmp3) nil) + (progn (setq a (qcar tmp3)) t)))))))) (|mkAtree1| - (CONS (QUOTE IF) - (CONS - (CONS (QUOTE |not|) (CONS |p| NIL)) - (CONS |a| (CONS (QUOTE |noBranch|) NIL)))))) - ((AND (CONSP |x|) (EQ (QCAR |x|) (QUOTE RULEDEF))) - (CONS (|mkAtreeNode| (QUOTE RULEDEF)) (CDR |x|))) - ((AND (CONSP |x|) - (EQ (QCAR |x|) (QUOTE MDEF)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (CONSP |ISTMP#1|) - (PROGN - (SPADLET |sym| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (PROGN - (SPADLET |junk1| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (CONSP |ISTMP#3|) - (PROGN - (SPADLET |junk2| (QCAR |ISTMP#3|)) - (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) - (AND - (CONSP |ISTMP#4|) - (EQ (QCDR |ISTMP#4|) NIL) - (PROGN (SPADLET |val| (QCAR |ISTMP#4|)) (QUOTE T))))))))))) + (cons 'IF + (cons + (cons '|not| (cons p nil)) + (cons a (cons '|noBranch| nil)))))) + ((and (consp x) (eq (qcar x) 'ruledef)) + (cons (|mkAtreeNode| 'ruledef) (cdr x))) + ((and (consp x) + (eq (qcar x) 'mdef) + (progn + (setq tmp1 (qcdr x)) + (and + (consp tmp1) + (progn + (setq sym (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (progn + (setq junk1 (qcar tmp2)) + (setq tmp3 (qcdr tmp2)) + (and + (consp tmp3) + (progn + (setq junk2 (qcar tmp3)) + (setq tmp4 (qcdr tmp3)) + (and + (consp tmp4) + (eq (qcdr tmp4) nil) + (progn (setq val (qcar tmp4)) t)))))))))) (|mkAtree1| - (CONS (QUOTE DEF) - (CONS - (CONS (QUOTE |macro|) (CONS |sym| NIL)) - (CONS |junk1| (CONS |junk2| (CONS |val| NIL))))))) - ((AND (CONSP |x|) - (EQ (QCAR |x|) (QUOTE ~=)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (CONSP |ISTMP#1|) - (PROGN - (SPADLET |a| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T))))))) + (cons 'def + (cons + (cons '|macro| (cons sym nil)) + (cons junk1 (cons junk2 (cons val nil))))))) + ((and (consp x) + (eq (qcar x) '~=) + (progn + (setq tmp1 (qcdr x)) + (and + (consp tmp1) + (progn + (setq a (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (eq (qcdr tmp2) nil) + (progn (setq b (qcar tmp2)) t)))))) (|mkAtree1| - (CONS (QUOTE |not|) - (CONS (CONS (QUOTE =) (CONS |a| (CONS |b| NIL))) NIL)))) - ((AND (CONSP |x|) - (EQ (QCAR |x|) (QUOTE +->)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SPADLET |funargs| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |funbody| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (COND - ((AND (CONSP |funbody|) - (EQ (QCAR |funbody|) (QUOTE |:|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |funbody|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SPADLET |body| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |type| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (SPADLET |types| (CONS |type| NIL)) (SPADLET |funbody| |body|)) - ((QUOTE T) (SPADLET |types| (CONS NIL NIL)))) - (SPADLET |v| (|collectDefTypesAndPreds| |funargs|)) - (SPADLET |types| (APPEND |types| (ELT |v| 1))) - (CONS - (|mkAtreeNode| (QUOTE ADEF)) - (CONS - (CONS - (ELT |v| 0) - (CONS |types| - (CONS - (PROG (#4=#:G166721) - (SPADLET #4# NIL) - (RETURN - (DO ((#5=#:G166726 |types| (CDR #5#)) (|a| NIL)) - ((OR (ATOM #5#) (PROGN (SETQ |a| (CAR #5#)) NIL)) - (NREVERSE0 #4#)) - (SEQ (EXIT (SETQ #4# (CONS NIL #4#))))))) - (CONS |funbody| NIL)))) - (CONS - (COND ((ELT |v| 2) (ELT |v| 2)) ((QUOTE T) (QUOTE T))) - (CONS NIL NIL))))) - ((AND (CONSP |x|) - (EQ (QCAR |x|) (QUOTE ADEF)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SPADLET |arg| (QCAR |ISTMP#1|)) - (SPADLET |r| (QCDR |ISTMP#1|)) - (QUOTE T))))) - (SPADLET |r| (|mkAtreeValueOf| |r|)) - (SPADLET |v| - (COND - ((NULL |arg|) (VECTOR NIL NIL NIL)) - ((AND (CONSP |arg|) (CDR |arg|) (NEQUAL (CAR |arg|) (QUOTE |\||))) - (|collectDefTypesAndPreds| (CONS (QUOTE |Tuple|) |arg|))) - ((NULL (CDR |arg|)) (|collectDefTypesAndPreds| (CAR |arg|))) - ((QUOTE T) (|collectDefTypesAndPreds| |arg|)))) - (SPADLET |types| (CAR |r|)) - (SPADLET |r'| (CDR |r|)) - (SPADLET |at| - (PROG (#6=#:G166737) - (SPADLET #6# NIL) - (RETURN - (DO ((#7=#:G166743 (CDR |types|) (CDR #7#)) - (|x| NIL) - (#8=#:G166744 (ELT |v| 1) (CDR #8#)) - (|y| NIL)) - ((OR (ATOM #7#) - (PROGN (SETQ |x| (CAR #7#)) NIL) - (ATOM #8#) - (PROGN (SETQ |y| (CAR #8#)) NIL)) - (NREVERSE0 #6#)) - (SEQ (EXIT (SETQ #6# (CONS (|mkAtree3,fn| |x| |y|) #6#)))))))) - (SPADLET |r| (CONS (CONS (CAR |types|) |at|) |r'|)) - (CONS - (|mkAtreeNode| (QUOTE ADEF)) - (CONS - (CONS (ELT |v| 0) |r|) - (CONS - (COND ((ELT |v| 2) (ELT |v| 2)) ((QUOTE T) (QUOTE T))) - (CONS NIL NIL))))) - ((AND (CONSP |x|) - (EQ (QCAR |x|) (QUOTE |where|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (CONSP |ISTMP#1|) - (PROGN - (SPADLET |before| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |after| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (CONS - (|mkAtreeNode| (QUOTE |where|)) - (CONS |before| (CONS (|mkAtree1| |after|) NIL)))) - ((AND (CONSP |x|) - (EQ (QCAR |x|) (QUOTE DEF)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (CONSP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQ (QCAR |ISTMP#2|) (QUOTE |macro|)) - (PROGN - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (CONSP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (PROGN (SPADLET |form| (QCAR |ISTMP#3|)) (QUOTE T)))))) - (PROGN - (SPADLET |ISTMP#4| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#4|) - (PROGN - (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) - (AND - (CONSP |ISTMP#5|) - (PROGN - (SPADLET |ISTMP#6| (QCDR |ISTMP#5|)) - (AND - (CONSP |ISTMP#6|) - (EQ (QCDR |ISTMP#6|) NIL) - (PROGN (SPADLET |body| (QCAR |ISTMP#6|)) (QUOTE T))))))))))) - (CONS (|mkAtreeNode| (QUOTE MDEF)) (CONS |form| (CONS |body| NIL)))) - ((AND (CONSP |x|) - (EQ (QCAR |x|) (QUOTE DEF)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (CONSP |ISTMP#1|) - (PROGN - (SPADLET |a| (QCAR |ISTMP#1|)) - (SPADLET |r| (QCDR |ISTMP#1|)) - (QUOTE T))))) - (SPADLET |r| (|mkAtreeValueOf| |r|)) - (COND - ((AND (CONSP |a|) - (PROGN - (SPADLET |op| (QCAR |a|)) - (SPADLET |arg| (QCDR |a|)) - (QUOTE T))) - (SPADLET |v| - (COND - ((NULL |arg|) (VECTOR NIL NIL NIL)) - ((AND (CONSP |arg|) (CDR |arg|) (NEQUAL (CAR |arg|) (QUOTE |\||))) - (|collectDefTypesAndPreds| (CONS (QUOTE |Tuple|) |arg|))) - ((NULL (CDR |arg|)) (|collectDefTypesAndPreds| (CAR |arg|))) - ((QUOTE T) (|collectDefTypesAndPreds| |arg|)))) - (SPADLET |types| (CAR |r|)) - (SPADLET |r'| (CDR |r|)) - (SPADLET |at| - (PROG (#9=#:G166758) - (SPADLET #9# NIL) - (RETURN - (DO ((#10=#:G166764 (CDR |types|) (CDR #10#)) - (|x| NIL) - (#11=#:G166765 (ELT |v| 1) (CDR #11#)) - (|y| NIL)) - ((OR (ATOM #10#) - (PROGN (SETQ |x| (CAR #10#)) NIL) - (ATOM #11#) - (PROGN (SETQ |y| (CAR #11#)) NIL)) - (NREVERSE0 #9#)) - (SEQ (EXIT (SETQ #9# (CONS (|mkAtree3,fn| |x| |y|) #9#)))))))) - (SPADLET |r| (CONS (CONS (CAR |types|) |at|) |r'|)) - (CONS - (|mkAtreeNode| (QUOTE DEF)) - (CONS - (CONS (CONS |op| (ELT |v| 0)) |r|) - (CONS - (COND ((ELT |v| 2) (ELT |v| 2)) ((QUOTE T) (QUOTE T))) - (CONS NIL NIL))))) - ((QUOTE T) - (CONS - (|mkAtreeNode| (QUOTE DEF)) - (CONS (CONS |a| |r|) (CONS (QUOTE T) (CONS NIL NIL))))))) - ((QUOTE T) - (SPADLET |z| - (COND - ((|getBasicMode| |op|) - (SPADLET |v| (|mkAtreeNode| |$immediateDataSymbol|)) - (|putValue| |v| (|getBasicObject| |op|)) |v|) - ((ATOM |op|) (|mkAtreeNode| |op|)) ((QUOTE T) (|mkAtree1| |op|)))) - (CONS |z| - (PROG (#12=#:G166778) - (SPADLET #12# NIL) - (RETURN - (DO ((#13=#:G166783 |argl| (CDR #13#)) (|y| NIL)) - ((OR (ATOM #13#) (PROGN (SETQ |y| (CAR #13#)) NIL)) - (NREVERSE0 #12#)) - (SEQ (EXIT (SETQ #12# (CONS (|mkAtree1| |y|) #12#)))))))))))))) + (cons '|not| + (cons (cons '= (cons a (cons b nil))) nil)))) + ((and (consp x) + (eq (qcar x) '+->) + (progn + (setq tmp1 (qcdr x)) + (and (consp tmp1) + (progn + (setq funargs (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (eq (qcdr tmp2) nil) + (progn (setq funbody (qcar tmp2)) t)))))) + (cond + ((and (consp funbody) + (eq (qcar funbody) '|:|) + (progn + (setq tmp1 (qcdr funbody)) + (and (consp tmp1) + (progn + (setq body (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (eq (qcdr tmp2) nil) + (progn (setq type (qcar tmp2)) t)))))) + (setq types (cons type nil)) (setq funbody body)) + (t (setq types (cons nil nil)))) + (setq v (|collectDefTypesAndPreds| funargs)) + (setq types (append types (elt v 1))) + (cons + (|mkAtreeNode| 'adef) + (cons + (cons + (elt v 0) + (cons types + (cons + (let (g4) + (DO ((g5 types (CDR g5)) (a NIL)) + ((OR (ATOM g5) (PROGN (SETQ a (CAR g5)) NIL)) + (NREVERSE0 g4)) + (SEQ (EXIT (SETQ g4 (CONS NIL g4)))))) + (cons funbody nil)))) + (cons + (cond ((elt v 2) (elt v 2)) (t t)) + (cons nil nil))))) + ((and (consp x) + (eq (qcar x) 'adef) + (progn + (setq tmp1 (qcdr x)) + (and (consp tmp1) + (progn + (setq arg (qcar tmp1)) + (setq r (qcdr tmp1)) + t)))) + (setq r (|mkAtreeValueOf| r)) + (setq v + (cond + ((null arg) (vector nil nil nil)) + ((and (consp arg) (cdr arg) (nequal (car arg) '|\||)) + (|collectDefTypesAndPreds| (cons '|Tuple| arg))) + ((null (cdr arg)) (|collectDefTypesAndPreds| (car arg))) + (t (|collectDefTypesAndPreds| arg)))) + (setq types (car r)) + (setq rp (cdr r)) + (setq at + (let (g6) + (do ((g7 (cdr types) (cdr g7)) + (x nil) + (g8 (elt v 1) (cdr g8)) + (y nil)) + ((or (atom g7) + (progn (setq x (car g7)) nil) + (atom g8) + (progn (setq y (car g8)) nil)) + (nreverse0 g6)) + (setq g6 (cons (|mkAtree3,fn| x y) g6))))) + (setq r (cons (cons (car types) at) rp)) + (cons + (|mkAtreeNode| 'adef) + (cons + (cons (elt v 0) r) + (cons + (cond ((elt v 2) (elt v 2)) (t t)) + (cons nil nil))))) + ((and (consp x) + (eq (qcar x) '|where|) + (progn + (setq tmp1 (qcdr x)) + (and + (consp tmp1) + (progn + (setq before (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (eq (qcdr tmp2) nil) + (progn (setq after (qcar tmp2)) t)))))) + (cons + (|mkAtreeNode| '|where|) + (cons before (cons (|mkAtree1| after) nil)))) + ((and (consp x) + (eq (qcar x) 'def) + (progn + (setq tmp1 (qcdr x)) + (and + (consp tmp1) + (progn + (setq tmp2 (qcar tmp1)) + (and + (consp tmp2) + (eq (qcar tmp2) '|macro|) + (progn + (setq tmp3 (qcdr tmp2)) + (and + (consp tmp3) + (eq (qcdr tmp3) nil) + (progn (setq form (qcar tmp3)) t))))) + (progn + (setq tmp4 (qcdr tmp1)) + (and + (consp tmp4) + (progn + (setq tmp5 (qcdr tmp4)) + (and + (consp tmp5) + (progn + (setq tmp6 (qcdr tmp5)) + (and + (consp tmp6) + (eq (qcdr tmp6) nil) + (progn (setq body (qcar tmp6)) t)))))))))) + (cons (|mkAtreeNode| 'mdef) (cons form (cons body nil)))) + ((and (consp x) + (eq (qcar x) 'def) + (progn + (setq tmp1 (qcdr x)) + (and + (consp tmp1) + (progn + (setq a (qcar tmp1)) + (setq r (qcdr tmp1)) + t)))) + (setq r (|mkAtreeValueOf| r)) + (cond + ((and (consp a) + (progn + (setq op (qcar a)) + (setq arg (qcdr a)) + t)) + (setq v + (cond + ((null arg) (vector nil nil nil)) + ((and (consp arg) (cdr arg) (nequal (car arg) '|\||)) + (|collectDefTypesAndPreds| (cons '|Tuple| arg))) + ((null (cdr arg)) (|collectDefTypesAndPreds| (car arg))) + (t (|collectDefTypesAndPreds| arg)))) + (setq types (car r)) + (setq rp (cdr r)) + (setq at + (let (g9) + (do ((g10 (cdr types) (cdr g10)) + (x nil) + (g11 (elt v 1) (cdr g11)) + (y nil)) + ((or (atom g10) + (progn (setq x (car g10)) nil) + (atom g11) + (progn (setq y (car g11)) nil)) + (nreverse0 g9)) + (setq g9 (cons (|mkAtree3,fn| x y) g9))))) + (setq r (cons (cons (car types) at) rp)) + (cons + (|mkAtreeNode| 'def) + (cons + (cons (cons op (elt v 0)) r) + (cons + (cond ((elt v 2) (elt v 2)) (t t)) + (cons nil nil))))) + (t + (cons + (|mkAtreeNode| 'def) + (cons (cons a r) (cons t (cons nil nil))))))) + (t + (setq z + (cond + ((|getBasicMode| op) + (setq v (|mkAtreeNode| |$immediateDataSymbol|)) + (|putValue| v (|getBasicObject| op)) v) + ((ATOM op) (|mkAtreeNode| op)) (t (|mkAtree1| op)))) + (cons z + (let (g12) + (DO ((g13 argl (CDR g13)) (y nil)) + ((or (atom g13) (progn (setq y (car g13)) nil)) + (nreverse0 g12)) + (setq g12 (cons (|mkAtree1| y) g12))))))))) \end{chunk} \subsection{collectDefTypesAndPreds} @@ -1163,114 +1134,111 @@ a vector of three things: ; vars := [args] ; VECTOR(vars,types,pred) -(DEFUN |collectDefTypesAndPreds,addPred| (|old| |new|) - (SEQ - (IF (NULL |new|) (EXIT |old|)) - (IF (NULL |old|) (EXIT |new|)) - (EXIT (CONS (QUOTE |and|) (CONS |old| (CONS |new| NIL)))))) +(defun |collectDefTypesAndPreds,addPred| (old new) + (cond + ((null new) old) + ((null old) new) + (t (list '|and| old new)))) -(DEFUN |collectDefTypesAndPreds| (|args|) - (PROG (|var| |p| |ISTMP#1| |var'| |ISTMP#2| |type| |args'| |v| |pred| - |types| |vars| |junk|) +(defun |collectDefTypesAndPreds| (args) + (PROG (var p tmp1 varp tmp2 type argsp v pred types vars junk) (RETURN (SEQ (PROGN - (SPADLET |pred| (SPADLET |types| (SPADLET |vars| NIL))) - (SPADLET |junk| - (COND - ((IDENTP |args|) - (SPADLET |types| (CONS NIL NIL)) - (SPADLET |vars| (CONS |args| NIL))) - ((AND (CONSP |args|) - (EQ (QCAR |args|) (QUOTE |:|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |args|)) - (AND - (CONSP |ISTMP#1|) - (PROGN - (SPADLET |var| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |type| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (SPADLET |types| (CONS |type| NIL)) - (COND - ((AND (CONSP |var|) - (EQ (QCAR |var|) (QUOTE |\||)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |var|)) - (AND - (CONSP |ISTMP#1|) - (PROGN - (SPADLET |var'| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |p| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (SPADLET |vars| (CONS |var'| NIL)) - (SPADLET |pred| (|collectDefTypesAndPreds,addPred| |pred| |p|))) - ((QUOTE T) (SPADLET |vars| (CONS |var| NIL))))) - ((AND (CONSP |args|) - (EQ (QCAR |args|) (QUOTE |\||)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |args|)) - (AND - (CONSP |ISTMP#1|) - (PROGN - (SPADLET |var| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |p| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (SPADLET |pred| (|collectDefTypesAndPreds,addPred| |pred| |p|)) - (COND - ((AND (CONSP |var|) - (EQ (QCAR |var|) (QUOTE |:|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |var|)) - (AND - (CONSP |ISTMP#1|) - (PROGN - (SPADLET |var'| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |type| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (SPADLET |types| (CONS |type| NIL)) - (SPADLET |vars| (CONS |var'| NIL))) - ((OR (AND (CONSP |var|) (EQ (QCAR |var|) (QUOTE |Tuple|))) - (AND (CONSP |var|) (EQ (QCAR |var|) (QUOTE |\||)))) - (SPADLET |v| (|collectDefTypesAndPreds| |var|)) - (SPADLET |vars| (APPEND |vars| (ELT |v| 0))) - (SPADLET |types| (APPEND |types| (ELT |v| 1))) - (SPADLET |pred| - (|collectDefTypesAndPreds,addPred| |pred| (ELT |v| 2)))) - ((QUOTE T) - (SPADLET |vars| (CONS |var| NIL)) - (SPADLET |types| (CONS NIL NIL))))) - ((AND (CONSP |args|) - (EQ (QCAR |args|) (QUOTE |Tuple|)) - (PROGN (SPADLET |args'| (QCDR |args|)) (QUOTE T))) - (DO ((#0=#:G166967 |args'| (CDR #0#)) (|a| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |a| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |v| (|collectDefTypesAndPreds| |a|)) - (SPADLET |vars| (APPEND |vars| (CONS (CAR (ELT |v| 0)) NIL))) - (SPADLET |types| (APPEND |types| (CONS (CAR (ELT |v| 1)) NIL))) - (SPADLET |pred| - (|collectDefTypesAndPreds,addPred| |pred| (ELT |v| 2)))))))) - ((QUOTE T) - (SPADLET |types| (CONS NIL NIL)) - (SPADLET |vars| (CONS |args| NIL))))) - (VECTOR |vars| |types| |pred|)))))) + (setq pred (setq types (setq vars NIL))) + (setq junk + (cond + ((identp args) + (setq types (cons nil nil)) + (setq vars (cons args nil))) + ((and (consp args) + (eq (qcar args) '|:|) + (progn + (setq tmp1 (qcdr args)) + (and + (consp tmp1) + (progn + (setq var (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (eq (qcdr tmp2) nil) + (progn (setq type (qcar tmp2)) t)))))) + (setq types (cons type nil)) + (cond + ((and (consp var) + (eq (qcar var) '|\||) + (progn + (setq tmp1 (qcdr var)) + (and + (consp tmp1) + (progn + (setq varp (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (eq (qcdr tmp2) nil) + (progn (setq p (qcar tmp2)) t)))))) + (setq vars (cons varp nil)) + (setq pred (|collectDefTypesAndPreds,addPred| pred p))) + (t (setq vars (cons var nil))))) + ((and (consp args) + (eq (qcar args) '|\||) + (progn + (setq tmp1 (qcdr args)) + (and + (consp tmp1) + (progn + (setq var (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (eq (qcdr tmp2) nil) + (progn (setq p (qcar tmp2)) t)))))) + (setq pred (|collectDefTypesAndPreds,addPred| pred p)) + (cond + ((and (consp var) + (eq (qcar var) '|:|) + (progn + (setq tmp1 (qcdr var)) + (and + (consp tmp1) + (progn + (setq varp (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and + (consp tmp2) + (eq (qcdr tmp2) nil) + (progn (setq type (qcar tmp2)) t)))))) + (setq types (cons type nil)) + (setq vars (cons varp nil))) + ((or (and (consp var) (eq (qcar var) '|Tuple|)) + (and (consp var) (eq (qcar var) '|\||))) + (setq v (|collectDefTypesAndPreds| var)) + (setq vars (append vars (elt v 0))) + (setq types (append types (elt v 1))) + (setq pred + (|collectDefTypesAndPreds,addPred| pred (elt v 2)))) + (t + (setq vars (cons var nil)) + (setq types (cons nil nil))))) + ((and (consp args) + (eq (qcar args) '|Tuple|) + (progn (setq argsp (qcdr args)) t)) + (do ((g0 argsp (cdr g0)) (a nil)) + ((or (atom g0) (progn (setq a (car g0)) nil)) nil) + (setq v (|collectDefTypesAndPreds| a)) + (setq vars (append vars (cons (car (elt v 0)) nil))) + (setq types (append types (cons (car (elt v 1)) nil))) + (setq pred + (|collectDefTypesAndPreds,addPred| pred (elt v 2))))) + (t + (setq types (cons nil nil)) + (setq vars (cons args nil))))) + (vector vars types pred)))))) \end{chunk} + \subsection{mkAtreeValueOf} \begin{chunk}{*} ;mkAtreeValueOf l == @@ -1278,12 +1246,13 @@ a vector of three things: ; not CONTAINED('valueOf,l) => l ; mkAtreeValueOf1 l -(DEFUN |mkAtreeValueOf| (|l|) - (COND - ((NULL (CONTAINED (QUOTE |valueOf|) |l|)) |l|) - ((QUOTE T) (|mkAtreeValueOf1| |l|)))) +(defun |mkAtreeValueOf| (z) + (cond + ((null (contained '|valueOf| z)) z) + (t (|mkAtreeValueOf1| z)))) \end{chunk} + \subsection{mkAtreeValueOf1} \begin{chunk}{*} ;mkAtreeValueOf1 l == @@ -1295,47 +1264,43 @@ a vector of three things: ; v ; [mkAtreeValueOf1 x for x in l] -(DEFUN |mkAtreeValueOf1| (|l|) - (PROG (|ISTMP#1| |u| |v|) +(defun |mkAtreeValueOf1| (z) + (let (tmp1 u v) (declare (special |$InteractiveFrame| |$immediateDataSymbol|)) - (RETURN - (SEQ - (COND - ((OR (NULL |l|) (ATOM |l|) (NULL (CDR |l|))) |l|) - ((AND - (CONSP |l|) - (EQ (QCAR |l|) (QUOTE |valueOf|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |l|)) - (AND - (CONSP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |u| (QCAR |ISTMP#1|)) (QUOTE T)))) - (IDENTP |u|)) - (SPADLET |v| (|mkAtreeNode| |$immediateDataSymbol|)) - (|putValue| |v| - (OR - (|get| |u| (QUOTE |value|) |$InteractiveFrame|) - (|objNewWrap| |u| (CONS (QUOTE |Variable|) (CONS |u| NIL))))) - |v|) - ((QUOTE T) - (PROG (#0=#:G167032) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G167037 |l| (CDR #1#)) (|x| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) - (SEQ (EXIT (SETQ #0# (CONS (|mkAtreeValueOf1| |x|) #0#))))))))))))) + (cond + ((or (null z) (atom z) (null (cdr z))) z) + ((and + (consp z) + (eq (qcar z) '|valueOf|) + (progn + (setq tmp1 (qcdr z)) + (and + (consp tmp1) + (eq (qcdr tmp1) nil) + (progn (setq u (qcar tmp1)) t))) + (identp u)) + (setq v (|mkAtreeNode| |$immediateDataSymbol|)) + (|putValue| v + (or + (|get| u '|value| |$InteractiveFrame|) + (mkObjWrap u (cons '|Variable| (cons u nil))))) + v) + (t + (let (g0) + (do ((g1 z (cdr g1)) (x nil)) + ((or (atom g1) (progn (setq x (car g1)) nil)) (nreverse0 g0)) + (setq g0 (cons (|mkAtreeValueOf1| x) g0)))))))) \end{chunk} \subsection{mkLessOrEqual} \begin{chunk}{*} ;mkLessOrEqual(lhs,rhs) == ['not,['_<,rhs,lhs]] -(DEFUN |mkLessOrEqual| (|lhs| |rhs|) - (CONS (QUOTE |not|) - (CONS (CONS (QUOTE <) (CONS |rhs| (CONS |lhs| NIL))) NIL))) +(defun |mkLessOrEqual| (lhs rhs) + (list '|not| (list '< rhs lhs) )) \end{chunk} + \subsection{emptyAtree} Remove mode, value, and misc. info from attrib tree \begin{chunk}{*} @@ -1349,22 +1314,21 @@ Remove mode, value, and misc. info from attrib tree ; atom expr => nil ; for e in expr repeat emptyAtree e -(DEFUN |emptyAtree| (|expr|) +(defun |emptyAtree| (expr) (declare (special |$immediateDataSymbol|)) - (SEQ - (COND - ((VECP |expr|) - (COND - ((BOOT-EQUAL |$immediateDataSymbol| (ELT |expr| 0)) NIL) - ((QUOTE T) - (SETELT |expr| 1 NIL) (SETELT |expr| 2 NIL) (SETELT |expr| 3 NIL)))) - ((ATOM |expr|) NIL) - ((QUOTE T) - (DO ((#0=#:G167058 |expr| (CDR #0#)) (|e| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |e| (CAR #0#)) NIL)) NIL) - (SEQ (EXIT (|emptyAtree| |e|)))))))) + (cond + ((vecp expr) + (cond ; operation name or literal + ((equal |$immediateDataSymbol| (elt expr 0)) nil) + (t + (setelt expr 1 nil) ; declared mode of variable + (setelt expr 2 nil) ; computed value of subtree from this node + (setelt expr 3 nil)))) ; list of single computed mode of subtree + ((atom expr) nil) + (t (dolist (e expr) (|emptyAtree| e))))) \end{chunk} + \subsection{unVectorize} Transforms from an atree back into a tree \begin{chunk}{*} @@ -1382,38 +1346,39 @@ Transforms from an atree back into a tree ; [newOp,:unVectorize argl] ; systemErrorHere '"unVectorize" -(DEFUN |unVectorize| (|body|) - (PROG (|name| |op| |argl| |newOp|) +(defun |unVectorize| (body) + (let (name op argl newOp) (declare (special |$elt| |$immediateDataSymbol|)) - (RETURN - (COND - ((VECP |body|) - (SPADLET |name| (|getUnname| |body|)) - (COND - ((NEQUAL |name| |$immediateDataSymbol|) |name|) - ((QUOTE T) (|objValUnwrap| (|getValue| |body|))))) - ((ATOM |body|) |body|) - ((AND - (CONSP |body|) - (PROGN - (SPADLET |op| (QCAR |body|)) - (SPADLET |argl| (QCDR |body|)) - (QUOTE T))) - (SPADLET |newOp| (|unVectorize| |op|)) - (COND - ((BOOT-EQUAL |newOp| (QUOTE SUCHTHAT)) - (SPADLET |newOp| (QUOTE |\||)))) - (COND - ((BOOT-EQUAL |newOp| (QUOTE COERCE)) - (SPADLET |newOp| (QUOTE |::|)))) - (COND - ((BOOT-EQUAL |newOp| (QUOTE |Dollar|)) - (SPADLET |newOp| (QUOTE |$elt|)))) - (CONS |newOp| (|unVectorize| |argl|))) - ((QUOTE T) (|systemErrorHere| "unVectorize")))))) + (cond + ((vecp body) + (setq name (|getUnname| body)) + (cond + ((nequal name |$immediateDataSymbol|) name) + (t (|objValUnwrap| (|getValue| body))))) + ((atom body) body) + ((and + (consp body) + (progn + (setq op (qcar body)) + (setq argl (qcdr body)) + t)) + (setq newOp (|unVectorize| op)) + (cond + ((eq newOp 'suchthat) + (setq newOp '|\||))) + (cond + ((eq newOp 'coerce) + (setq newOp '|::|))) + (cond + ((eq newOp '|Dollar|) + (setq newOp '|$elt|))) + (cons newOp (|unVectorize| argl))) + (t (|systemErrorHere| "unVectorize"))))) \end{chunk} + \section{Stuffing and Getting Info} + \subsection{putAtree} \begin{chunk}{*} ;putAtree(x,prop,val) == @@ -1428,20 +1393,19 @@ Transforms from an atree back into a tree ; x.4 := insertShortAlist(prop,val,x.4) ; x -(DEFUN |putAtree| (|x| |prop| |val|) - (PROG (|op| |n|) - (RETURN - (COND - ((AND (CONSP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (QUOTE T))) - (COND ((VECP |op|) (|putAtree| |op| |prop| |val|))) |x|) - ((NULL (VECP |x|)) |x|) - ((SPADLET |n| - (QLASSQ |prop| (QUOTE ((|mode| . 1) (|value| . 2) (|modeSet| . 3))))) - (SETELT |x| |n| |val|)) - ((QUOTE T) - (SETELT |x| 4 (|insertShortAlist| |prop| |val| (ELT |x| 4))) |x|))))) +(defun |putAtree| (x prop val) + (let (op n) + (cond + ((and (consp x) (progn (setq op (qcar x)) t)) + (cond ((vecp op) (|putAtree| op prop val))) x) + ((null (vecp x)) x) + ((setq n (qlassq prop '((|mode| . 1) (|value| . 2) (|modeSet| . 3)))) + (setelt x n val)) + (t + (setelt x 4 (|insertShortAlist| prop val (elt x 4))) x)))) \end{chunk} + \subsection{getAtree} \begin{chunk}{*} ;getAtree(x,prop) == @@ -1455,19 +1419,18 @@ Transforms from an atree back into a tree ; => x.n ; QLASSQ(prop,x.4) -(DEFUN |getAtree| (|x| |prop|) - (PROG (|op| |n|) - (RETURN - (COND - ((AND (CONSP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (QUOTE T))) - (COND ((VECP |op|) (|getAtree| |op| |prop|)) ((QUOTE T) NIL))) - ((NULL (VECP |x|)) NIL) - ((SPADLET |n| - (QLASSQ |prop| (QUOTE ((|mode| . 1) (|value| . 2) (|modeSet| . 3))))) - (ELT |x| |n|)) - ((QUOTE T) (QLASSQ |prop| (ELT |x| 4))))))) +(defun |getAtree| (x prop) + (let (op n) + (cond + ((and (consp x) (progn (setq op (qcar x)) t)) + (cond ((vecp op) (|getAtree| op prop)) (t nil))) + ((null (vecp x)) nil) + ((setq n (QLASSQ prop '((|mode| . 1) (|value| . 2) (|modeSet| . 3)))) + (elt x n)) + (t (qlassq prop (elt x 4)))))) \end{chunk} + \subsection{putTarget} \begin{chunk}{*} ;putTarget(x, targ) == @@ -1475,20 +1438,22 @@ Transforms from an atree back into a tree ; if targ = $EmptyMode then targ := nil ; putAtree(x,'target,targ) -(DEFUN |putTarget| (|x| |targ|) +(defun |putTarget| (x targ) (declare (special |$EmptyMode|)) - (PROGN - (COND ((BOOT-EQUAL |targ| |$EmptyMode|) (SPADLET |targ| NIL))) - (|putAtree| |x| (QUOTE |target|) |targ|))) + (cond ((equal targ |$EmptyMode|) (setq targ nil))) + (|putAtree| x '|target| targ)) \end{chunk} + \subsection{getTarget} \begin{chunk}{*} ;getTarget(x) == getAtree(x,'target) -(DEFUN |getTarget| (|x|) (|getAtree| |x| (QUOTE |target|))) +(defun |getTarget| (x) + (|getAtree| x '|target|)) \end{chunk} + \subsection{insertShortAlist} \begin{chunk}{*} ;insertShortAlist(prop,val,al) == @@ -1497,14 +1462,14 @@ Transforms from an atree back into a tree ; al ; [[prop,:val],:al] -(DEFUN |insertShortAlist| (|prop| |val| |al|) - (PROG (|pair|) - (RETURN - (COND - ((SPADLET |pair| (QASSQ |prop| |al|)) (RPLACD |pair| |val|) |al|) - ((QUOTE T) (CONS (CONS |prop| |val|) |al|)))))) +(defun |insertShortAlist| (prop val al) + (let (pair) + (cond + ((setq pair (qassq prop al)) (rplacd pair val) al) + (t (cons (cons prop val) al))))) \end{chunk} + \subsection{transferPropsToNode} \begin{chunk}{*} ;transferPropsToNode(x,t) == @@ -1525,51 +1490,48 @@ Transforms from an atree back into a tree ; putMode(t,am) ; t -(DEFUN |transferPropsToNode,transfer| (|x| |node| |prop|) - (PROG (|u|) +(defun |transferPropsToNode,transfer| (x node prop) + (PROG (u) (declare (special |$e| |$localVars| |$env|)) (RETURN (SEQ - (IF (SPADLET |u| (|get| |x| |prop| |$env|)) - (EXIT (|putAtree| |node| |prop| |u|))) + (IF (setq u (|get| x prop |$env|)) + (EXIT (|putAtree| node prop u))) (EXIT - (IF (AND (NULL (|member| |x| |$localVars|)) - (SPADLET |u| (|get| |x| |prop| |$e|))) - (EXIT (|putAtree| |node| |prop| |u|)))))))) + (IF (AND (NULL (|member| x |$localVars|)) + (setq u (|get| x prop |$e|))) + (EXIT (|putAtree| node prop u)))))))) -(DEFUN |transferPropsToNode| (|x| |t|) - (PROG (|propList| |node| |am|) +(defun |transferPropsToNode| (x tt) + (let (propList node am) (declare (special |$env|)) - (RETURN - (SEQ - (PROGN - (SPADLET |propList| (|getProplist| |x| |$env|)) - (COND - ((OR (QLASSQ (QUOTE |Led|) |propList|) (QLASSQ (QUOTE |Nud|) |propList|)) - NIL) - ((QUOTE T) - (SPADLET |node| (COND ((VECP |t|) |t|) ((QUOTE T) (CAR |t|)))) - (DO ((#0=#:G167124 - (QUOTE (|mode| |localModemap| |value| |name| |generatedCode|)) - (CDR #0#)) - (|prop| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |prop| (CAR #0#)) NIL)) NIL) - (SEQ (EXIT (|transferPropsToNode,transfer| |x| |node| |prop|)))) - (COND - ((AND - (NULL (|getMode| |t|)) - (SPADLET |am| (|get| |x| (QUOTE |automode|) |$env|))) - (|putModeSet| |t| (CONS |am| NIL)) (|putMode| |t| |am|))) |t|))))))) + (setq propList (|getProplist| x |$env|)) + (cond + ((or (qlassq '|Led| propList) (qlassq '|Nud| propList)) nil) + (t + (setq node (cond ((vecp tt) tt) (t (car tt)))) + (do ((g0 '(|mode| |localModemap| |value| |name| |generatedCode|) (cdr g0)) + (prop nil)) + ((or (atom g0) (progn (setq prop (car g0)) nil)) nil) + (|transferPropsToNode,transfer| x node prop)) + (cond + ((and + (null (|getMode| tt)) + (setq am (|get| x '|automode| |$env|))) + (|putModeSet| tt (cons am nil)) (|putMode| tt am))) tt)))) \end{chunk} + \subsection{isLeaf} May be a number or a vector \begin{chunk}{*} ; isLeaf x == atom x -(DEFUN |isLeaf| (|x|) (ATOM |x|)) +(defun |isLeaf| (x) + (atom x)) \end{chunk} + \subsection{getMode} \begin{chunk}{*} ;getMode x == @@ -1578,17 +1540,16 @@ May be a number or a vector ; m := getBasicMode x => m ; keyedSystemError("S2II0001",[x]) -(DEFUN |getMode| (|x|) - (PROG (|op| |m|) - (RETURN - (COND - ((AND (CONSP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (QUOTE T))) - (|getMode| |op|)) - ((VECP |x|) (ELT |x| 1)) - ((SPADLET |m| (|getBasicMode| |x|)) |m|) - ((QUOTE T) (|keyedSystemError| (QUOTE S2II0001) (CONS |x| NIL))))))) +(defun |getMode| (x) + (let (op m) + (cond + ((and (consp x) (progn (setq op (qcar x)) t)) (|getMode| op)) + ((vecp x) (elt x 1)) + ((setq m (|getBasicMode| x)) m) + (t (|keyedSystemError| 'S2II0001 (cons x nil)))))) \end{chunk} + \subsection{putMode} \begin{chunk}{*} ;putMode(x,y) == @@ -1596,16 +1557,15 @@ May be a number or a vector ; null VECP x => keyedSystemError("S2II0001",[x]) ; x.1 := y -(DEFUN |putMode| (|x| |y|) - (PROG (|op|) - (RETURN - (COND - ((AND (CONSP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (QUOTE T))) - (|putMode| |op| |y|)) - ((NULL (VECP |x|)) (|keyedSystemError| (QUOTE S2II0001) (CONS |x| NIL))) - ((QUOTE T) (SETELT |x| 1 |y|)))))) +(defun |putMode| (x y) + (let (op) + (cond + ((and (consp x) (progn (setq op (qcar x)) t)) (|putMode| op y)) + ((null (vecp x)) (|keyedSystemError| 'S2II0001 (cons x nil))) + (t (setelt x 1 y))))) \end{chunk} + \subsection{getValue} \begin{chunk}{*} ;getValue x == @@ -1615,18 +1575,18 @@ May be a number or a vector ; keyedSystemError("S2II0001",[x]) ; getValue first x -(DEFUN |getValue| (|x|) - (PROG (|t|) - (RETURN - (COND - ((VECP |x|) (ELT |x| 2)) - ((ATOM |x|) - (COND - ((SPADLET |t| (|getBasicObject| |x|)) |t|) - ((QUOTE T) (|keyedSystemError| (QUOTE S2II0001) (CONS |x| NIL))))) - ((QUOTE T) (|getValue| (CAR |x|))))))) +(defun |getValue| (x) + (let (z) + (cond + ((vecp x) (elt x 2)) + ((atom x) + (cond + ((setq z (|getBasicObject| x)) z) + (t (|keyedSystemError| 'S2II0001 (cons x nil))))) + (t (|getValue| (car x)))))) \end{chunk} + \subsection{putValue} \begin{chunk}{*} ;putValue(x,y) == @@ -1634,25 +1594,27 @@ May be a number or a vector ; null VECP x => keyedSystemError("S2II0001",[x]) ; x.2 := y -(DEFUN |putValue| (|x| |y|) - (PROG (|op|) - (RETURN - (COND - ((AND (CONSP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (QUOTE T))) - (|putValue| |op| |y|)) - ((NULL (VECP |x|)) (|keyedSystemError| (QUOTE S2II0001) (CONS |x| NIL))) - ((QUOTE T) (SETELT |x| 2 |y|)))))) +(defun |putValue| (x y) + (let (op) + (cond + ((and (consp x) (progn (setq op (qcar x)) t)) (|putValue| op y)) + ((null (vecp x)) (|keyedSystemError| 'S2II0001 (cons x nil))) + (t (setelt x 2 y))))) \end{chunk} + \subsection{putValueValue} \begin{chunk}{*} ;putValueValue(vec,val) == ; putValue(vec,val) ; vec -(DEFUN |putValueValue| (|vec| |val|) (PROGN (|putValue| |vec| |val|) |vec|)) +(defun |putValueValue| (vec val) + (|putValue| vec val) + vec) \end{chunk} + \subsection{getUnnameIfCan} \begin{chunk}{*} ;getUnnameIfCan x == @@ -1661,31 +1623,30 @@ May be a number or a vector ; atom x => x ; nil -(DEFUN |getUnnameIfCan| (|x|) - (PROG (|op|) - (RETURN - (COND - ((VECP |x|) (ELT |x| 0)) - ((AND (CONSP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (QUOTE T))) - (|getUnnameIfCan| |op|)) - ((ATOM |x|) |x|) ((QUOTE T) NIL))))) +(defun |getUnnameIfCan| (x) + (let (op) + (cond + ((vecp x) (elt x 0)) + ((and (consp x) (progn (setq op (qcar x)) t)) (|getUnnameIfCan| op)) + ((atom x) x) + (t nil)))) \end{chunk} + \subsection{getUnname} \begin{chunk}{*} ;getUnname x == ; x is [op,:.] => getUnname op ; getUnname1 x -(DEFUN |getUnname| (|x|) - (PROG (|op|) - (RETURN - (COND - ((AND (CONSP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (QUOTE T))) - (|getUnname| |op|)) - ((QUOTE T) (|getUnname1| |x|)))))) +(defun |getUnname| (x) + (let (op) + (cond + ((and (consp x) (progn (setq op (qcar x)) t)) (|getUnname| op)) + (t (|getUnname1| x))))) \end{chunk} + \subsection{getUnname1} \begin{chunk}{*} ;getUnname1 x == @@ -1693,11 +1654,11 @@ May be a number or a vector ; null atom x => keyedSystemError("S2II0001",[x]) ; x -(DEFUN |getUnname1| (|x|) - (COND - ((VECP |x|) (ELT |x| 0)) - ((NULL (ATOM |x|)) (|keyedSystemError| (QUOTE S2II0001) (CONS |x| NIL))) - ((QUOTE T) |x|))) +(defun |getUnname1| (x) + (cond + ((vecp x) (elt x 0)) + ((null (atom x)) (|keyedSystemError| 'S2II0001 (cons x nil))) + (t x))) \end{chunk} \subsection{computedMode} @@ -1706,22 +1667,22 @@ May be a number or a vector ; getModeSet t is [m] => m ; keyedSystemError("S2GE0016",['"computedMode",'"non-singleton modeset"]) -(DEFUN |computedMode| (|t|) - (PROG (|ISTMP#1| |m|) - (RETURN - (COND - ((PROGN - (SPADLET |ISTMP#1| (|getModeSet| |t|)) - (AND - (CONSP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |m| (QCAR |ISTMP#1|)) (QUOTE T)))) - |m|) - ((QUOTE T) - (|keyedSystemError| (QUOTE S2GE0016) - (CONS "computedMode" (CONS "non-singleton modeset" NIL)))))))) +(defun |computedMode| (tt) + (let (tmp1 m) + (cond + ((progn + (setq tmp1 (|getModeSet| tt)) + (and + (consp tmp1) + (eq (qcdr tmp1) nil) + (progn (setq m (qcar tmp1)) t))) + m) + (t + (|keyedSystemError| 'S2GE0016 + (list "computedMode" "non-singleton modeset")))))) \end{chunk} + \subsection{putModeSet} \begin{chunk}{*} ;putModeSet(x,y) == @@ -1730,16 +1691,15 @@ May be a number or a vector ; x.3 := y ; y -(DEFUN |putModeSet| (|x| |y|) - (PROG (|op|) - (RETURN - (COND - ((AND (CONSP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (QUOTE T))) - (|putModeSet| |op| |y|)) - ((NULL (VECP |x|)) (|keyedSystemError| (QUOTE S2II0001) (CONS |x| NIL))) - ((QUOTE T) (SETELT |x| 3 |y|) |y|))))) +(defun |putModeSet| (x y) + (let (op) + (cond + ((and (consp x) (progn (setq op (qcar x)) t)) (|putModeSet| op y)) + ((null (vecp x)) (|keyedSystemError| 'S2II0001 (cons x nil))) + (t (setelt x 3 y) y)))) \end{chunk} + \subsection{getModeOrFirstModeSetIfThere} \begin{chunk}{*} ;getModeOrFirstModeSetIfThere x == @@ -1754,30 +1714,29 @@ May be a number or a vector ; m := getBasicMode x => m ; NIL -(DEFUN |getModeOrFirstModeSetIfThere| (|x|) - (PROG (|op| |val| |y| |ISTMP#1| |m|) +(defun |getModeOrFirstModeSetIfThere| (x) + (let (op val y tmp1 m) (declare (special |$EmptyMode|)) - (RETURN - (COND - ((AND (CONSP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (QUOTE T))) - (|getModeOrFirstModeSetIfThere| |op|)) - ((VECP |x|) - (COND - ((SPADLET |m| (ELT |x| 1)) |m|) - ((SPADLET |val| (ELT |x| 2)) (|objMode| |val|)) - ((SPADLET |y| (ELT |x| 3)) - (COND - ((AND (BOOT-EQUAL |y| (CONS |$EmptyMode| NIL)) - (PROGN - (SPADLET |ISTMP#1| (SPADLET |m| (|getMode| |x|))) - (AND (CONSP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) (QUOTE |Mapping|))))) - |m|) - ((QUOTE T) (CAR |y|)))) - ((QUOTE T) NIL))) - ((SPADLET |m| (|getBasicMode| |x|)) |m|) ((QUOTE T) NIL))))) + (cond + ((and (consp x) (progn (setq op (qcar x)) t)) + (|getModeOrFirstModeSetIfThere| op)) + ((vecp x) + (cond + ((setq m (elt x 1)) m) + ((setq val (elt x 2)) (|objMode| val)) + ((setq y (elt x 3)) + (cond + ((and (equal y (cons |$EmptyMode| nil)) + (progn + (setq tmp1 (setq m (|getMode| x))) + (and (consp tmp1) (eq (qcar tmp1) '|Mapping|)))) + m) + (t (car y)))) + (t nil))) + ((setq m (|getBasicMode| x)) m) (t nil)))) \end{chunk} + \subsection{getModeSet} \begin{chunk}{*} ;getModeSet x == @@ -1793,34 +1752,33 @@ May be a number or a vector ; keyedSystemError("S2GE0016",['"getModeSet", ; '"not an attributed tree"]) -(DEFUN |getModeSet| (|x|) - (PROG (|y| |ISTMP#1| |m|) +(defun |getModeSet| (x) + (let (y tmp1 m) (declare (special |$EmptyMode|)) - (RETURN - (COND - ((AND |x| (CONSP |x|)) (|getModeSet| (CAR |x|))) - ((VECP |x|) - (COND - ((SPADLET |y| (ELT |x| 3)) - (COND - ((AND (BOOT-EQUAL |y| (CONS |$EmptyMode| NIL)) - (PROGN - (SPADLET |ISTMP#1| (SPADLET |m| (|getMode| |x|))) - (AND - (CONSP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) (QUOTE |Mapping|))))) - (CONS |m| NIL)) - ((QUOTE T) |y|))) - ((QUOTE T) - (|keyedSystemError| (QUOTE S2GE0016) - (CONS "getModeSet" (CONS "no mode set" NIL)))))) - ((SPADLET |m| (|getBasicMode| |x|)) (CONS |m| NIL)) - ((NULL (ATOM |x|)) (|getModeSet| (CAR |x|))) - ((QUOTE T) - (|keyedSystemError| (QUOTE S2GE0016) - (CONS "getModeSet" (CONS "not an attributed tree" NIL)))))))) + (cond + ((and x (consp x)) (|getModeSet| (car x))) + ((vecp x) + (cond + ((setq y (elt x 3)) + (cond + ((and (equal y (cons |$EmptyMode| nil)) + (progn + (setq tmp1 (setq m (|getMode| x))) + (and + (consp tmp1) + (eq (qcar tmp1) '|Mapping|)))) + (cons m nil)) + (t y))) + (t + (|keyedSystemError| 'S2GE0016 (list "getModeSet" "no mode set"))))) + ((setq m (|getBasicMode| x)) (cons m nil)) + ((null (atom x)) (|getModeSet| (car x))) + (t + (|keyedSystemError| 'S2GE0016 + (list "getModeSet" "not an attributed tree")))))) \end{chunk} + \subsection{getModeSetUseSubdomain} \begin{chunk}{*} ;getModeSetUseSubdomain x == @@ -1850,55 +1808,57 @@ May be a number or a vector ; keyedSystemError("S2GE0016", ; ['"getModeSetUseSubomain",'"not an attributed tree"]) -(DEFUN |getModeSetUseSubdomain| (|x|) - (PROG (|y| |ISTMP#1| |val| |f| |m|) +(defun |getModeSetUseSubdomain| (x) + (let (y tmp1 val f m) (declare (special |$Integer| |$immediateDataSymbol| |$EmptyMode|)) - (RETURN - (COND - ((AND |x| (CONSP |x|)) (|getModeSetUseSubdomain| (CAR |x|))) - ((VECP |x|) - (COND - ((|getAtree| |x| (QUOTE |retracted|)) (|getModeSet| |x|)) - ((SPADLET |y| (ELT |x| 3)) - (COND - ((AND - (BOOT-EQUAL |y| (CONS |$EmptyMode| NIL)) - (PROGN - (SPADLET |ISTMP#1| (SPADLET |m| (|getMode| |x|))) - (AND (CONSP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |Mapping|))))) - (CONS |m| NIL)) - ((QUOTE T) - (SPADLET |val| (|getValue| |x|)) - (COND - ((AND (BOOT-EQUAL (ELT |x| 0) |$immediateDataSymbol|) - (BOOT-EQUAL |y| (CONS |$Integer| NIL))) - (SPADLET |val| (|objValUnwrap| |val|)) - (SPADLET |m| (|getBasicMode0| |val| (QUOTE T))) - (SETELT |x| 2 (|objNewWrap| |val| |m|)) - (SETELT |x| 3 (CONS |m| NIL)) - (CONS |m| NIL)) - ((NULL |val|) |y|) - ((AND (|isEqualOrSubDomain| (|objMode| |val|) |$Integer|) - (INTEGERP (SPADLET |f| (|objValUnwrap| |val|)))) - (CONS (|getBasicMode0| |f| (QUOTE T)) NIL)) - ((QUOTE T) |y|))))) - ((QUOTE T) - (|keyedSystemError| (QUOTE S2GE0016) - (CONS "getModeSetUseSubomain" (CONS "no mode set" NIL)))))) - ((SPADLET |m| (|getBasicMode0| |x| (QUOTE T))) (CONS |m| NIL)) - ((NULL (ATOM |x|)) (|getModeSetUseSubdomain| (CAR |x|))) - ((QUOTE T) - (|keyedSystemError| (QUOTE S2GE0016) - (CONS "getModeSetUseSubomain" (CONS "not an attributed tree" NIL)))))))) + (cond + ((and x (consp x)) (|getModeSetUseSubdomain| (car x))) + ((vecp x) + (cond + ((|getAtree| x '|retracted|) (|getModeSet| x)) + ((setq y (elt x 3)) + (cond + ((and + (equal y (cons |$EmptyMode| nil)) + (progn + (setq tmp1 (setq m (|getMode| x))) + (and (consp tmp1) (eq (qcar tmp1) '|Mapping|)))) + (cons m nil)) + (t + (setq val (|getValue| x)) + (cond + ((and (equal (elt x 0) |$immediateDataSymbol|) + (equal y (cons |$Integer| nil))) + (setq val (|objValUnwrap| val)) + (setq m (|getBasicMode0| val t)) + (setelt x 2 (mkObjWrap val m)) + (setelt x 3 (cons m nil)) + (cons m nil)) + ((null val) y) + ((and (|isEqualOrSubDomain| (|objMode| val) |$Integer|) + (integerp (setq f (|objValUnwrap| val)))) + (cons (|getBasicMode0| f t) nil)) + (t y))))) + (t + (|keyedSystemError| 'S2GE0016 + (list "getModeSetUseSubomain" "no mode set"))))) + ((setq m (|getBasicMode0| x t)) (cons m nil)) + ((null (atom x)) (|getModeSetUseSubdomain| (car x))) + (t + (|keyedSystemError| 'S2GE0016 + (list "getModeSetUseSubomain" "not an attributed tree")))))) \end{chunk} + \subsection{atree2EvaluatedTree} \begin{chunk}{*} ;atree2EvaluatedTree x == atree2Tree1(x,true) -(DEFUN |atree2EvaluatedTree| (|x|) (|atree2Tree1| |x| (QUOTE T))) +(defun |atree2EvaluatedTree| (x) + (|atree2Tree1| x t)) \end{chunk} + \subsection{atree2Tree1} \begin{chunk}{*} ;atree2Tree1(x,evalIfTrue) == @@ -1909,29 +1869,24 @@ May be a number or a vector ; x ; [atree2Tree1(y,evalIfTrue) for y in x] -(DEFUN |atree2Tree1| (|x| |evalIfTrue|) - (PROG (|triple|) +(defun |atree2Tree1| (x evalIfTrue) + (let (triple) (declare (special |$mapName| |$OutputForm| |$EmptyMode|)) - (RETURN - (SEQ - (COND - ((AND (SPADLET |triple| (|getValue| |x|)) - (NEQUAL (|objMode| |triple|) |$EmptyMode|)) - (|coerceOrCroak| |triple| |$OutputForm| |$mapName|)) - ((|isLeaf| |x|) - (COND ((VECP |x|) (ELT |x| 0)) ((QUOTE T) |x|))) - ((QUOTE T) - (PROG (#0=#:G167247) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G167252 |x| (CDR #1#)) (|y| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# (CONS (|atree2Tree1| |y| |evalIfTrue|) #0#))))))))))))) + (cond + ((and (setq triple (|getValue| x)) + (nequal (|objMode| triple) |$EmptyMode|)) + (|coerceOrCroak| triple |$OutputForm| |$mapName|)) + ((|isLeaf| x) (cond ((vecp x) (elt x 0)) (t x))) + (t + (let (g0) + (do ((g1 x (cdr g1)) (y nil)) + ((or (atom g1) (progn (setq y (car g1)) nil)) (nreverse0 g0)) + (setq g0 (cons (|atree2Tree1| y evalIfTrue) g0)))))))) \end{chunk} + \section{Environment Utilities} + \subsection{getValueFromEnvironment} \begin{chunk}{*} ;getValueFromEnvironment(x,mode) == @@ -1941,26 +1896,26 @@ May be a number or a vector ; throwKeyedMsg("S2IE0001",[x]) ; objValUnwrap v -(DEFUN |getValueFromEnvironment| (|x| |mode|) - (PROG (|v|) +(defun |getValueFromEnvironment| (x mode) + (let (v) (declare (special |$e| |$failure| |$env|)) - (RETURN - (COND - ((NEQUAL |$failure| - (SPADLET |v| (|getValueFromSpecificEnvironment| |x| |mode| |$env|))) - |v|) - ((NEQUAL |$failure| - (SPADLET |v| (|getValueFromSpecificEnvironment| |x| |mode| |$e|))) - |v|) - ((NULL - (SPADLET |v| + (cond + ((nequal |$failure| + (setq v (|getValueFromSpecificEnvironment| x mode |$env|))) + v) + ((nequal |$failure| + (setq v (|getValueFromSpecificEnvironment| x mode |$e|))) + v) + ((null + (setq v (|coerceInt| - (|objNew| |x| (CONS (QUOTE |Variable|) (CONS |x| NIL))) - |mode|))) - (|throwKeyedMsg| (QUOTE S2IE0001) (CONS |x| NIL))) - ((QUOTE T) (|objValUnwrap| |v|)))))) + (mkObj x (cons '|Variable| (cons x nil))) + mode))) + (|throwKeyedMsg| 'S2IE0001 (cons x nil))) + (t (|objValUnwrap| v))))) \end{chunk} + \subsection{getValueFromSpecificEnvironment} \begin{chunk}{*} ;getValueFromSpecificEnvironment(id,mode,e) == @@ -1988,54 +1943,52 @@ May be a number or a vector ; $failure ; $failure -(DEFUN |getValueFromSpecificEnvironment| (|id| |mode| |e|) - (PROG (|v| |mapSig| |v'| |m| |m'| |u|) +(defun |getValueFromSpecificEnvironment| (id mode e) + (let (v mapSig vp m mp u) (declare (special |$failure| |$EmptyMode|)) - (RETURN - (COND - ((CONSP |e|) - (COND - ((SPADLET |u| (|get| |id| (QUOTE |value|) |e|)) - (COND - ((BOOT-EQUAL (|objMode| |u|) |$EmptyMode|) + (cond + ((consp e) + (cond + ((setq u (|get| id '|value| e)) + (cond + ((equal (|objMode| u) |$EmptyMode|) (|systemErrorHere| "getValueFromSpecificEnvironment")) - ((QUOTE T) - (SPADLET |v| (|objValUnwrap| |u|)) - (COND - ((NULL - (AND - (CONSP |mode|) - (EQ (QCAR |mode|) (QUOTE |Mapping|)) - (PROGN (SPADLET |mapSig| (QCDR |mode|)) (QUOTE T)))) - |v|) - ((NULL (AND (CONSP |v|) (EQ (QCAR |v|) (QUOTE MAP)))) |v|) - ((QUOTE T) - (SPADLET |v'| (|coerceInt| |u| |mode|)) - (COND - ((NULL |v'|) - (|throwKeyedMsg| (QUOTE S2IC0002) - (CONS (|objMode| |u|) (CONS |mode| NIL)))) - ((QUOTE T) (|objValUnwrap| |v'|)))))))) - ((SPADLET |m| (|get| |id| (QUOTE |mode|) |e|)) - (COND - ((|isPartialMode| |m|) - (SPADLET |m'| - (|resolveTM| (CONS (QUOTE |Variable|) (CONS |id| NIL)) |m|))) - ((QUOTE T) (SPADLET |m'| |m|))) - (COND - ((AND |m'| - (SPADLET |u| + (t + (setq v (|objValUnwrap| u)) + (cond + ((null + (and + (consp mode) + (eq (qcar mode) '|Mapping|) + (progn (setq mapSig (qcdr mode)) t))) + v) + ((null (and (consp v) (eq (qcar v) 'map))) v) + (t + (setq vp (|coerceInt| u mode)) + (cond + ((null vp) + (|throwKeyedMsg| 'S2IC0002 (list (|objMode| u) mode))) + (t (|objValUnwrap| vp)))))))) + ((setq m (|get| id '|mode| e)) + (cond + ((|isPartialMode| m) + (setq mp + (|resolveTM| (cons '|Variable| (cons id nil)) m))) + (t (setq mp m))) + (cond + ((and mp + (setq u (|coerceInteractive| - (|objNewWrap| |id| (CONS (QUOTE |Variable|) (CONS |id| NIL))) - |m'|))) - (|objValUnwrap| |u|)) - ((QUOTE T) - (|throwKeyedMsg| (QUOTE S2IE0002) (CONS |id| (CONS |m| NIL)))))) - ((QUOTE T) |$failure|))) - ((QUOTE T) |$failure|))))) + (mkObjWrap id (list '|Variable| id)) + mp))) + (|objValUnwrap| u)) + (t + (|throwKeyedMsg| 'S2IE0002 (list id m))))) + (t |$failure|))) + (t |$failure|)))) \end{chunk} -\end{chunk} + \subsection{augProplistInteractive} \begin{chunk}{*} ;augProplistInteractive(proplist,prop,val) == @@ -2044,46 +1997,49 @@ May be a number or a vector ; proplist ; [[prop,:val],:proplist] -(DEFUN |augProplistInteractive| (|proplist| |prop| |val|) - (PROG (|u|) - (RETURN - (COND - ((SPADLET |u| (ASSQ |prop| |proplist|)) (RPLACD |u| |val|) |proplist|) - ((QUOTE T) (CONS (CONS |prop| |val|) |proplist|)))))) +(defun |augProplistInteractive| (proplist prop val) + (let (u) + (cond + ((setq u (assq prop proplist)) (rplacd u val) proplist) + (t (cons (cons prop val) proplist))))) \end{chunk} + \subsection{getFlag} \begin{chunk}{*} ;getFlag x == get("--flags--",x,$e) -(DEFUN |getFlag| (|x|) +(defun |getFlag| (x) (declare (special |$e|)) - (|get| (QUOTE |--flags--|) |x| |$e|)) + (|get| '|--flags--| x |$e|)) \end{chunk} + \subsection{putFlag} \begin{chunk}{*} ;putFlag(flag,value) == ; $e := put ("--flags--", flag, value, $e) -(DEFUN |putFlag| (|flag| |value|) +(defun |putFlag| (flag value) (declare (special |$e|)) - (SPADLET |$e| (|put| (QUOTE |--flags--|) |flag| |value| |$e|))) + (setq |$e| (|put| '|--flags--| flag value |$e|))) \end{chunk} + \subsection{get} \begin{chunk}{*} ;get(x,prop,e) == ; $InteractiveMode => get0(x,prop,e) ; get1(x,prop,e) -(DEFUN |get| (|x| |prop| |e|) +(defun |get| (x prop e) (declare (special |$InteractiveMode|)) - (COND - (|$InteractiveMode| (|get0| |x| |prop| |e|)) - ((QUOTE T) (|get1| |x| |prop| |e|)))) + (cond + (|$InteractiveMode| (|get0| x prop e)) + (t (|get1| x prop e)))) \end{chunk} + \subsection{get0} \begin{chunk}{*} ;get0(x,prop,e) == @@ -2093,18 +2049,18 @@ May be a number or a vector ; QLASSQ(prop,u) ; nil -(DEFUN |get0| (|x| |prop| |e|) - (PROG (|tail| |u|) - (RETURN - (COND - ((NULL (ATOM |x|)) (|get| (QCAR |x|) |prop| |e|)) - ((SPADLET |u| (QLASSQ |x| (CAR (QCAR |e|)))) (QLASSQ |prop| |u|)) - ((AND (SPADLET |tail| (CDR (QCAR |e|))) - (SPADLET |u| (|fastSearchCurrentEnv| |x| |tail|))) - (QLASSQ |prop| |u|)) - ((QUOTE T) NIL))))) +(defun |get0| (x prop e) + (let (tail u) + (cond + ((null (atom x)) (|get| (qcar x) prop e)) + ((setq u (qlassq x (car (qcar e)))) (qlassq prop u)) + ((and (setq tail (cdr (qcar e))) + (setq u (|fastSearchCurrentEnv| x tail))) + (qlassq prop u)) + (t nil)))) \end{chunk} + \subsection{get1} We try to avoid lookups in the environment if it is clear that the lookup will fail. The \verb|$envHashTable| was populated in @@ -2128,44 +2084,37 @@ addBinding (see g-util.boot.pamphlet). ; SAY ["get1",x,prop,ress and true] ; ress -(DEFUN |get1| (|x| |prop| |e|) - (PROG (|negHash| |ress|) +(defun |get1| (x prop e) + (prog (negHash ress) (declare (special |$CapsuleModemapFrame| |$insideCapsuleFunctionIfTrue| |$envHashTable| |$CategoryFrame|)) - (RETURN - (PROGN - (SPADLET |negHash| NIL) - (COND - ((NULL (ATOM |x|)) (|get| (QCAR |x|) |prop| |e|)) - ((QUOTE T) - (COND - ((AND |$envHashTable| - (NULL (EQ |$CategoryFrame| |e|)) - (NULL (EQ |prop| (QUOTE |modemap|)))) - (COND - ((NULL (HGET |$envHashTable| (CONS |x| (CONS |prop| NIL)))) - (RETURN NIL)) - ((QUOTE T) - (SPADLET |negHash| NIL))))) - (COND - ((AND (BOOT-EQUAL |prop| (QUOTE |modemap|)) - (BOOT-EQUAL |$insideCapsuleFunctionIfTrue| (QUOTE T))) - (SPADLET |ress| - (OR - (LASSOC (QUOTE |modemap|) (|getProplist| |x| |$CapsuleModemapFrame|)) - (|get2| |x| |prop| |e|))) - |ress|) - ((QUOTE T) - (SPADLET |ress| - (OR (LASSOC |prop| (|getProplist| |x| |e|)) (|get2| |x| |prop| |e|))) - (COND - ((AND |ress| |negHash|) - (SAY - (CONS "get1" - (CONS |x| (CONS |prop| (CONS (AND |ress| (QUOTE T)) NIL))))))) - |ress|)))))))) + (return + (cond + ((null (atom x)) (|get| (qcar x) prop e)) + (t + (cond + ((and |$envHashTable| + (null (eq |$CategoryFrame| e)) + (null (eq prop '|modemap|))) + (unless (hget |$envHashTable| (list x prop)) (return nil)))) + (cond + ((and (eq prop '|modemap|) + (eq |$insideCapsuleFunctionIfTrue| t)) + (setq ress + (or + (lassoc '|modemap| (|getProplist| x |$CapsuleModemapFrame|)) + (|get2| x prop e))) + ress) + (t + (setq ress (or (lassoc prop (|getProplist| x e)) (|get2| x prop e))) + (cond + ((and ress negHash) + (say + (list "get1" x prop (and ress t))))) + ress))))))) \end{chunk} + \subsection{get2} \begin{chunk}{*} ;get2(x,prop,e) == @@ -2174,56 +2123,60 @@ addBinding (see g-util.boot.pamphlet). ; nil ; nil -(DEFUN |get2| (|x| |prop| |e|) - (declare (ignore |e|)) - (PROG (|u|) - (RETURN - (COND - ((AND (BOOT-EQUAL |prop| (QUOTE |modemap|)) (|constructor?| |x|)) - (COND - ((SPADLET |u| (|getConstructorModemap| |x|)) (CONS |u| NIL)) - ((QUOTE T) NIL))) - ((QUOTE T) NIL))))) +(defun |get2| (x prop e) + (declare (ignore e)) + (let (u) + (cond + ((and (eq prop '|modemap|) (|constructor?| x)) + (cond + ((setq u (|getConstructorModemap| x)) (cons u nil)) + (t nil))) + (t nil)))) \end{chunk} + \subsection{getI} \begin{chunk}{*} ;getI(x,prop) == get(x,prop,$InteractiveFrame) -(DEFUN |getI| (|x| |prop|) +(defun |getI| (x prop) (declare (special |$InteractiveFrame|)) - (|get| |x| |prop| |$InteractiveFrame|)) + (|get| x prop |$InteractiveFrame|)) \end{chunk} + \subsection{putI} \begin{chunk}{*} ;putI(x,prop,val) == ($InteractiveFrame := put(x,prop,val,$InteractiveFrame)) -(DEFUN |putI| (|x| |prop| |val|) +(defun |putI| (x prop val) (declare (special |$InteractiveFrame|)) - (SPADLET |$InteractiveFrame| (|put| |x| |prop| |val| |$InteractiveFrame|))) + (setq |$InteractiveFrame| (|put| x prop val |$InteractiveFrame|))) \end{chunk} + \subsection{getIProplist} \begin{chunk}{*} ;getIProplist x == getProplist(x,$InteractiveFrame) -(DEFUN |getIProplist| (|x|) +(defun |getIProplist| (x) (declare (special |$InteractiveFrame|)) - (|getProplist| |x| |$InteractiveFrame|)) + (|getProplist| x |$InteractiveFrame|)) \end{chunk} + \subsection{removeBindingI} \begin{chunk}{*} ;removeBindingI x == ; RPLAC(CAAR $InteractiveFrame,deleteAssocWOC(x,CAAR $InteractiveFrame)) -(DEFUN |removeBindingI| (|x|) - (RPLAC - (CAAR |$InteractiveFrame|) - (|deleteAssocWOC| |x| (CAAR |$InteractiveFrame|)))) +(defun |removeBindingI| (x) + (rplac + (caar |$InteractiveFrame|) + (|deleteAssocWOC| x (caar |$InteractiveFrame|)))) \end{chunk} + \subsection{rempropI} \begin{chunk}{*} ;rempropI(x,prop) == @@ -2235,21 +2188,18 @@ addBinding (see g-util.boot.pamphlet). ; recordOldValue(id,prop,getI(id,prop)) ; $InteractiveFrame:= remprop(id,prop,$InteractiveFrame) -(DEFUN |rempropI| (|x| |prop|) - (PROG (|id|) +(defun |rempropI| (x prop) + (let (id) (declare (special |$InteractiveFrame|)) - (RETURN - (PROGN - (SPADLET |id| (COND ((ATOM |x|) |x|) ((QUOTE T) (CAR |x|)))) - (COND - ((|getI| |id| |prop|) - (PROGN - (|recordNewValue| |id| |prop| NIL) - (|recordOldValue| |id| |prop| (|getI| |id| |prop|)) - (SPADLET |$InteractiveFrame| - (|remprop| |id| |prop| |$InteractiveFrame|))))))))) + (setq id (cond ((atom x) x) (t (car x)))) + (cond + ((|getI| id prop) + (|recordNewValue| id prop nil) + (|recordOldValue| id prop (|getI| id prop)) + (setq |$InteractiveFrame| (|remprop| id prop |$InteractiveFrame|)))))) \end{chunk} + \subsection{remprop} \begin{chunk}{*} ;remprop(x,prop,e) == @@ -2258,16 +2208,16 @@ addBinding (see g-util.boot.pamphlet). ; e ; e -(DEFUN |remprop| (|x| |prop| |e|) - (PROG (|pl| |u|) - (RETURN - (COND - ((SPADLET |u| (|assoc| |prop| (SPADLET |pl| (|getProplist| |x| |e|)))) - (SPADLET |e| (|addBinding| |x| (DELASC (CAR |u|) |pl|) |e|)) - |e|) - ((QUOTE T) |e|))))) +(defun |remprop| (x prop e) + (let (pl u) + (cond + ((setq u (|assoc| prop (setq pl (|getProplist| x e)))) + (setq e (|addBinding| x (delasc (car u) pl) e)) + e) + (t e)))) \end{chunk} + \subsection{fastSearchCurrentEnv} \begin{chunk}{*} ;fastSearchCurrentEnv(x,currentEnv) == @@ -2275,21 +2225,20 @@ addBinding (see g-util.boot.pamphlet). ; while (currentEnv:= QCDR currentEnv) repeat ; u:= QLASSQ(x,CAR currentEnv) => u -(DEFUN |fastSearchCurrentEnv| (|x| |currentEnv|) - (PROG (|u|) +(defun |fastSearchCurrentEnv| (x currentEnv) + (PROG (u) (RETURN (SEQ - (COND - ((SPADLET |u| (QLASSQ |x| (CAR |currentEnv|))) |u|) - ((QUOTE T) - (DO () - ((NULL (SPADLET |currentEnv| (QCDR |currentEnv|))) NIL) - (SEQ - (EXIT - (COND - ((SPADLET |u| (QLASSQ |x| (CAR |currentEnv|))) (EXIT |u|)))))))))))) + (cond + ((setq u (qlassq x (car currentEnv))) u) + (t + (do () + ((null (setq currentEnv (qcdr currentEnv))) nil) + (cond + ((setq u (qlassq x (car currentEnv))) (exit u)))))))))) \end{chunk} + \subsection{put} \begin{chunk}{*} ;put(x,prop,val,e) == @@ -2306,30 +2255,29 @@ addBinding (see g-util.boot.pamphlet). ; e ; addBinding(x,newProplist,e) -(DEFUN |put| (|x| |prop| |val| |e|) - (PROG (|newProplist|) +(defun |put| (x prop val e) + (let (newProplist) (declare (special |$CapsuleModemapFrame| |$insideCapsuleFunctionIfTrue| |$CategoryFrame|)) - (RETURN - (COND - ((AND |$InteractiveMode| (NULL (EQ |e| |$CategoryFrame|))) - (|putIntSymTab| |x| |prop| |val| |e|)) - ((NULL (ATOM |x|)) (|put| (CAR |x|) |prop| |val| |e|)) - ((QUOTE T) - (SPADLET |newProplist| (|augProplistOf| |x| |prop| |val| |e|)) - (COND - ((AND (BOOT-EQUAL |prop| (QUOTE |modemap|)) - (BOOT-EQUAL |$insideCapsuleFunctionIfTrue| (QUOTE T))) - (SAY - (CONS "**** modemap PUT on CapsuleModemapFrame: " (CONS |val| NIL))) - (SPADLET |$CapsuleModemapFrame| - (|addBinding| |x| - (|augProplistOf| |x| (QUOTE |modemap|) |val| |$CapsuleModemapFrame|) + (cond + ((and |$InteractiveMode| (null (eq e |$CategoryFrame|))) + (|putIntSymTab| x prop val e)) + ((null (atom x)) (|put| (car x) prop val e)) + (t + (setq newProplist (|augProplistOf| x prop val e)) + (cond + ((and (eq prop '|modemap|) + (eq |$insideCapsuleFunctionIfTrue| t)) + (say (list "**** modemap PUT on CapsuleModemapFrame: " val)) + (setq |$CapsuleModemapFrame| + (|addBinding| x + (|augProplistOf| x '|modemap| val |$CapsuleModemapFrame|) |$CapsuleModemapFrame|)) - |e|) - ((QUOTE T) (|addBinding| |x| |newProplist| |e|)))))))) + e) + (t (|addBinding| x newProplist e))))))) \end{chunk} + \subsection{putIntSymTab} \begin{chunk}{*} ;putIntSymTab(x,prop,val,e) == @@ -2347,26 +2295,26 @@ addBinding (see g-util.boot.pamphlet). ; EQ(pl0,pl) => e ; addIntSymTabBinding(x,pl,e) -(DEFUN |putIntSymTab| (|x| |prop| |val| |e|) - (PROG (|pl0| |lp| |u| |pl|) - (RETURN - (COND - ((NULL (ATOM |x|)) (|putIntSymTab| (CAR |x|) |prop| |val| |e|)) - ((QUOTE T) - (SPADLET |pl0| (SPADLET |pl| (|search| |x| |e|))) - (SPADLET |pl| - (COND - ((NULL |pl|) (CONS (CONS |prop| |val|) NIL)) - ((SPADLET |u| (ASSQ |prop| |pl|)) (RPLACD |u| |val|) |pl|) - ((QUOTE T) - (SPADLET |lp| (LASTPAIR |pl|)) - (SPADLET |u| (CONS (CONS |prop| |val|) NIL)) - (RPLACD |lp| |u|) |pl|))) - (COND - ((EQ |pl0| |pl|) |e|) - ((QUOTE T) (|addIntSymTabBinding| |x| |pl| |e|)))))))) +(defun |putIntSymTab| (x prop val e) + (let (pl0 lp u pl) + (cond + ((null (atom x)) (|putIntSymTab| (car x) prop val e)) + (t + (setq pl0 (setq pl (|search| x e))) + (setq pl + (cond + ((null pl) (cons (cons prop val) nil)) + ((setq u (assq prop pl)) (rplacd u val) pl) + (t + (setq lp (lastpair pl)) + (setq u (cons (cons prop val) nil)) + (rplacd lp u) pl))) + (cond + ((eq pl0 pl) e) + (t (|addIntSymTabBinding| x pl e))))))) \end{chunk} + \subsection{addIntSymTabBinding} \begin{chunk}{*} ;addIntSymTabBinding(var,proplist,e is [[curContour,:.],:.]) == @@ -2377,17 +2325,15 @@ addBinding (see g-util.boot.pamphlet). ; RPLAC(CAAR e,[[var,:proplist],:curContour]) ; e -(DEFUN |addIntSymTabBinding| (|var| |proplist| |e|) - (PROG (|curContour| |u|) - (RETURN - (PROGN - (SPADLET |curContour| (CAAR |e|)) - (COND - ((SPADLET |u| (ASSQ |var| |curContour|)) (RPLACD |u| |proplist|) |e|) - ((QUOTE T) - (RPLAC (CAAR |e|) (CONS (CONS |var| |proplist|) |curContour|)) |e|)))))) +(defun |addIntSymTabBinding| (var proplist e) + (let (curContour u) + (setq curContour (caar e)) + (cond + ((setq u (assq var curContour)) (rplacd u proplist) e) + (t (rplac (caar e) (cons (cons var proplist) curContour)) e)))) \end{chunk} + \section{Source and position information} In the following, src is a string containing an original input line, line is the line number of the string within the source file, @@ -2399,57 +2345,77 @@ by x. x is a VAT. ;putSrcPos(x, file, src, line, col) == ; putAtree(x, 'srcAndPos, srcPos_New(file, src, line, col)) -(DEFUN |putSrcPos| (|x| |file| |src| |line| |col|) - (|putAtree| |x| (QUOTE |srcAndPos|) (|srcPosNew| |file| |src| |line| |col|))) +(defun |putSrcPos| (x file src line col) + (|putAtree| x '|srcAndPos| (|srcPosNew| file src line col))) \end{chunk} + \subsection{getSrcPos} \begin{chunk}{*} ;getSrcPos(x) == getAtree(x, 'srcAndPos) -(DEFUN |getSrcPos| (|x|) (|getAtree| |x| (QUOTE |srcAndPos|))) +(defun |getSrcPos| (x) + (|getAtree| x '|srcAndPos|)) \end{chunk} + \subsection{srcPosNew} \begin{chunk}{*} ;srcPosNew(file, src, line, col) == LIST2VEC [file, src, line, col] -(DEFUN |srcPosNew| (|file| |src| |line| |col|) - (LIST2VEC (CONS |file| (CONS |src| (CONS |line| (CONS |col| NIL)))))) +(defun |srcPosNew| (file src line col) + (list2vec (list file src line col))) \end{chunk} + \subsection{srcPosFile} \begin{chunk}{*} ;srcPosFile(sp) == ; if sp then sp.0 else nil -(DEFUN |srcPosFile| (|sp|) (COND (|sp| (ELT |sp| 0)) ((QUOTE T) NIL))) +(defun |srcPosFile| (sp) + (cond + (sp (elt sp 0)) + (t nil))) \end{chunk} + \subsection{srcPosSource} \begin{chunk}{*} ;srcPosSource(sp) == ; if sp then sp.1 else nil -(DEFUN |srcPosSource| (|sp|) (COND (|sp| (ELT |sp| 1)) ((QUOTE T) NIL))) +(defun |srcPosSource| (sp) + (cond + (sp (elt sp 1)) + (t nil))) \end{chunk} + \subsection{srcPosLine} \begin{chunk}{*} ;srcPosLine(sp) == ; if sp then sp.2 else nil -(DEFUN |srcPosLine| (|sp|) (COND (|sp| (ELT |sp| 2)) ((QUOTE T) NIL))) +(defun |srcPosLine| (sp) + (cond + (sp (elt sp 2)) + (t nil))) \end{chunk} + \subsection{srcPosColumn} \begin{chunk}{*} ;srcPosColumn(sp) == ; if sp then sp.3 else nil -(DEFUN |srcPosColumn| (|sp|) (COND (|sp| (ELT |sp| 3)) ((QUOTE T) NIL))) +(defun |srcPosColumn| (sp) + (cond + (sp (elt sp 3)) + (t nil))) \end{chunk} + \subsection{srcPosDisplay} \begin{chunk}{*} ;srcPosDisplay(sp) == @@ -2464,82 +2430,90 @@ by x. x is a VAT. ; sayBrightly [fillerSpaces(#s, '" "), dots, '"^"] ; true -(DEFUN |srcPosDisplay| (|sp|) - (PROG (|s| |col| |dots|) - (RETURN - (COND - ((NULL |sp|) NIL) - ((QUOTE T) - (SPADLET |s| - (STRCONC "\"" (|srcPosFile| |sp|) "\", line " - (STRINGIMAGE (|srcPosLine| |sp|)) ": ")) - (|sayBrightly| (CONS |s| (CONS (|srcPosSource| |sp|) NIL))) - (SPADLET |col| (|srcPosColumn| |sp|)) - (SPADLET |dots| - (COND - ((EQL |col| 0) "") - ((QUOTE T) (|fillerSpaces| |col| ".")))) - (|sayBrightly| - (CONS (|fillerSpaces| (|#| |s|) " ") (CONS |dots| (CONS "^" NIL)))) - (QUOTE T)))))) +(defun |srcPosDisplay| (sp) + (let (s col dots) + (cond + ((null sp) nil) + (t + (setq s + (strconc "\"" (|srcPosFile| sp) "\", line " + (stringimage (|srcPosLine| sp)) ": ")) + (|sayBrightly| (list s (|srcPosSource| sp))) + (setq col (|srcPosColumn| sp)) + (setq dots + (cond + ((eql col 0) "") + (t (|fillerSpaces| col ".")))) + (|sayBrightly| (list (|fillerSpaces| (|#| s) " ") dots "^")) + t)))) \end{chunk} + \section{Library compiler structures needed by the interpreter} Tuples and Crosses \subsection{asTupleNew} \begin{chunk}{*} ;asTupleNew(size, listOfElts) == CONS(size, LIST2VEC listOfElts) -(DEFUN |asTupleNew| (SIZE |listOfElts|) (CONS SIZE (LIST2VEC |listOfElts|))) +(defun |asTupleNew| (SIZE listOfElts) + (cons size (list2vec listOfElts))) \end{chunk} + \subsection{asTupleNew0} \begin{chunk}{*} ;asTupleNew0(listOfElts) == CONS(#listOfElts, LIST2VEC listOfElts) -(DEFUN |asTupleNew0| (|listOfElts|) - (CONS (|#| |listOfElts|) (LIST2VEC |listOfElts|))) +(defun |asTupleNew0| (listOfElts) + (cons (|#| listOfElts) (list2vec listOfElts))) \end{chunk} + \subsection{asTupleNewCode} \begin{chunk}{*} ;asTupleNewCode(size, listOfElts) == ["asTupleNew", size, ['LIST, :listOfElts]] -(DEFUN |asTupleNewCode| (SIZE |listOfElts|) - (CONS - (QUOTE |asTupleNew|) - (CONS SIZE (CONS (CONS (QUOTE LIST) |listOfElts|) NIL)))) +(defun |asTupleNewCode| (size listOfElts) + (cons '|asTupleNew| (list size (cons 'list listOfElts)))) \end{chunk} + \subsection{asTupleNewCode0} \begin{chunk}{*} ;asTupleNewCode0(listForm) == ["asTupleNew0", listForm] -(DEFUN |asTupleNewCode0| (|listForm|) - (CONS (QUOTE |asTupleNew0|) (CONS |listForm| NIL))) +(defun |asTupleNewCode0| (listForm) + (list '|asTupleNew0| listForm)) \end{chunk} + \subsection{asTupleSize} \begin{chunk}{*} ;asTupleSize(at) == CAR at -(DEFUN |asTupleSize| (|at|) (CAR |at|)) +(defun |asTupleSize| (at) + (car at)) \end{chunk} + \subsection{asTupleAsVector} \begin{chunk}{*} ;asTupleAsVector(at) == CDR at -(DEFUN |asTupleAsVector| (|at|) (CDR |at|)) +(defun |asTupleAsVector| (at) + (cdr at)) \end{chunk} + \subsection{asTupleAsList} \begin{chunk}{*} ;asTupleAsList(at) == VEC2LIST asTupleAsVector at -(DEFUN |asTupleAsList| (|at|) (VEC2LIST (|asTupleAsVector| |at|))) +(defun |asTupleAsList| (at) + (vec2list (|asTupleAsVector| at))) \end{chunk} + \eject \begin{thebibliography}{99} \bibitem{1} nothing diff --git a/src/interp/i-map.lisp.pamphlet b/src/interp/i-map.lisp.pamphlet index 5567165..7a7e3e5 100644 --- a/src/interp/i-map.lisp.pamphlet +++ b/src/interp/i-map.lisp.pamphlet @@ -483,7 +483,7 @@ NIL) ('T 'T))) (|putHist| |op| '|recursive| |recursive| |$e|) - (|objNew| |newMap| |type|)))))))) + (mkObj |newMap| |type|)))))))) ;augmentMap(op,args,pred,body,oldMap) == ; pattern:= makePattern(args,pred) @@ -1307,7 +1307,7 @@ ('T (SPADLET T$ (OR (|coerceInteractive| - (|objNewWrap| |x| (|maximalSuperType| |m|)) + (mkObjWrap |x| (|maximalSuperType| |m|)) |$OutputForm|) (RETURN |x|))) (|objValUnwrap| T$)))))) @@ -1973,7 +1973,7 @@ (CONS '|mkAtreeNode| (CONS (MKQ |argName|) NIL)) (CONS - (|objNewCode| + (mkObjCode (CONS '|wrap| (CONS |argName| NIL)) |type|) @@ -2058,7 +2058,7 @@ (CONS '|mkAtreeNode| (CONS (MKQ |argName|) NIL)) (CONS - (|objNewCode| + (mkObjCode (CONS '|wrap| (CONS (|wrapped2Quote| @@ -2069,7 +2069,7 @@ NIL))) G167311))))))))) (|putValue| |op| - (|objNew| + (mkObj (CONS '|rewriteMap1| (CONS (MKQ |opName|) (CONS |arglCode| @@ -2260,7 +2260,7 @@ (SPADLET |v| (|getValue| |arg|)) (SPADLET |evArgl| (CONS - (|objNew| (|objVal| |v|) + (mkObj (|objVal| |v|) (|objMode| |v|)) |evArgl|)))))) (SPADLET |$env| (CONS (CONS NIL NIL) NIL)) @@ -2746,7 +2746,7 @@ (|objVal| (OR (|coerceInteractive| - (|objNew| |arg| |t1|) |t2|) + (mkObj |arg| |t1|) |t2|) (|throwKeyedMsg| 'S2IC0001 (CONS |arg| (CONS |$mapName| diff --git a/src/interp/i-output.lisp.pamphlet b/src/interp/i-output.lisp.pamphlet index 8b6e340..8d7b9e2 100644 --- a/src/interp/i-output.lisp.pamphlet +++ b/src/interp/i-output.lisp.pamphlet @@ -653,7 +653,7 @@ these functions return an updated ``layout so far'' in general (CONS |$PositiveInteger| NIL)))))) (SPADLET |f| (SPADCALL |x| |y| |z| |float|)) (SPADLET |o| - (|coerceInteractive| (|mkObjWrap| |f| |domain|) + (|coerceInteractive| (mkObjWrap |f| |domain|) '(|OutputForm|))) (|objValUnwrap| |o|)) ('T (SPADLET |LETTMP#1| (|flattenOps| |x|)) @@ -4286,7 +4286,7 @@ NIL (|texFormat| (|outputDomainConstructor| |expr|))) ('T NIL))) ((SPADLET T$ - (|coerceInteractive| (|objNewWrap| |expr| |domain|) + (|coerceInteractive| (mkObjWrap |expr| |domain|) |$OutputForm|)) (SPADLET |x| (|objValUnwrap| T$)) (COND (|$formulaFormat| (|formulaFormat| |x|))) @@ -4552,7 +4552,7 @@ NIL ('T (SPADLET |x'| (|coerceInteractive| - (|objNewWrap| |x| |m|) + (mkObjWrap |x| |m|) |$OutputForm|)) (COND (|x'| diff --git a/src/interp/i-spec1.lisp.pamphlet b/src/interp/i-spec1.lisp.pamphlet index 58d679c..81618c7 100644 --- a/src/interp/i-spec1.lisp.pamphlet +++ b/src/interp/i-spec1.lisp.pamphlet @@ -261,7 +261,7 @@ There are several special modes used in these functions: (SPADLET |vars| |var|)) ('T (SPADLET |vars| (CONS '|Tuple| |vars|)))) (SPADLET |val| - (|objNewWrap| + (mkObjWrap (CONS '+-> (CONS |vars| (CONS |body| NIL))) |$AnonymousFunction|)) (|putValue| |t| |val|) @@ -416,7 +416,7 @@ There are several special modes used in these functions: (CONS '|mkAtreeNode| (CONS (MKQ |var|) NIL)) (CONS - (|objNewCode| + (mkObjCode (CONS '|wrap| (CONS |var| NIL)) |type|) @@ -543,7 +543,7 @@ There are several special modes used in these functions: (REVERSE |$freeVariables|)) NIL)))))) (SPADLET |val| - (|objNew| |code| + (mkObj |code| (SPADLET |rt| (CONS '|Mapping| (CONS |computedResultType| @@ -658,7 +658,7 @@ There are several special modes used in these functions: (INTERN (STRCONC "SAE" (STRINGIMAGE |a|)))) (SPADLET |saeTypeSynonymValue| - (|objNew| |sae| '(|Domain|))) + (mkObj |sae| '(|Domain|))) (SPADLET |fun| (|getFunctionFromDomain| '|generator| |sae| NIL)) @@ -667,7 +667,7 @@ There are several special modes used in these functions: |saeTypeSynonymValue| |$e|) (|putHist| |a| '|mode| |sae| |$e|) (|putHist| |a| '|value| - (SPADLET T2 (|objNew| |expr| |sae|)) |$e|) + (SPADLET T2 (mkObj |expr| |sae|)) |$e|) (|clearDependencies| |a| 'T) (COND (|$printTypeIfTrue| (|sayKeyedMsg| 'S2IS0003 NIL) @@ -1034,7 +1034,7 @@ There are several special modes used in these functions: ('T (SPADLET |code| (|wrap| NIL))))) ('T (SPADLET |triple'| - (|objNewCode| + (mkObjCode (CONS '|wrap| (CONS (|objVal| |triple|) NIL)) (|objMode| |triple|))) @@ -1054,7 +1054,7 @@ There are several special modes used in these functions: (CONS ''TRUE NIL)) (CONS (CONS ''T (CONS NIL NIL)) NIL)))))) - (|putValue| |op| (|objNew| |code| |$Boolean|)) + (|putValue| |op| (mkObj |code| |$Boolean|)) (|putModeSet| |op| (CONS |$Boolean| NIL)))))))))) ;--% Handlers for TARGET @@ -1264,7 +1264,7 @@ There are several special modes used in these functions: (|throwKeyedMsgCannotCoerceWithValue| |e| |t1| |m|)) (|$genValue| (|coerceOrRetract| |v| |t2|)) - ('T (|objNew| (|getArgValue| |tree| |t2|) |t2|)))))) + ('T (mkObj (|getArgValue| |tree| |t2|) |t2|)))))) (SPADLET |val| (OR |value| (|throwKeyedMsgCannotCoerceWithValue| |e| |t1| @@ -1992,7 +1992,7 @@ There are several special modes used in these functions: (COND (|$genValue| (SPADLET |code| (|wrap| (|timedEVALFUN| |code|))))) - (|putValue| |op| (|objNew| |code| |m|))))))) + (|putValue| |op| (mkObj |code| |m|))))))) ;falseFun(x) == nil @@ -2217,10 +2217,10 @@ There are several special modes used in these functions: (CONS (|objValUnwrap| (|coerceInteractive| - (|objNewWrap| |v| |m|) |t|)) + (mkObjWrap |v| |m|) |t|)) G167539)))))))) (|putValue| |op| - (|objNewWrap| + (mkObjWrap (|asTupleNew| (|#| |value|) |value|) |rm|)) (|putModeSet| |op| (CONS |rm| NIL))))))) @@ -2465,7 +2465,7 @@ There are several special modes used in these functions: (PROGN (SETQ |type| (CAR G167822)) NIL)) NIL) (SEQ (EXIT (|put| |i| '|value| - (|objNewWrap| |val| |type|) |$env|)))) + (mkObjWrap |val| |type|) |$env|)))) (SPADLET |LETTMP#1| (|bottomUp| |exp|)) (SPADLET |m| (CAR |LETTMP#1|)) (SPADLET |$collectTypeList| @@ -3000,7 +3000,7 @@ There are several special modes used in these functions: (|systemError| "Not a Stream")) ('T (SPADLET |newVal| - (|objNew| (|objVal| |val|) + (mkObj (|objVal| |val|) (CONS '|InfiniteTuple| (CONS |ud| NIL)))) (|putValue| |op| |newVal|) (|objMode| |newVal|))))))) @@ -3164,7 +3164,7 @@ There are several special modes used in these functions: NIL))) (SPADLET |vec| (|mkAtreeNode| (GENSYM))) (|putValue| |vec| - (|objNew| + (mkObj (CONS 'CONS (CONS |val| (CONS (CONS 'VECTOR @@ -3549,7 +3549,7 @@ There are several special modes used in these functions: (|systemError| "Not a Stream")) ('T (SPADLET |newVal| - (|objNew| (|objVal| |val|) + (mkObj (|objVal| |val|) (CONS '|InfiniteTuple| (CONS |ud| NIL)))) (|putValue| |op| |newVal|) (|objMode| |newVal|))))))) @@ -3782,7 +3782,7 @@ There are several special modes used in these functions: NIL))) (SPADLET |vec| (|mkAtreeNode| (GENSYM))) (|putValue| |vec| - (|objNew| + (mkObj (CONS 'CONS (CONS |val| (CONS (CONS 'VECTOR @@ -4164,8 +4164,8 @@ There are several special modes used in these functions: (SPADLET |val| (COND (|$genValue| - (|objNewWrap| (|timedEVALFUN| |code|) |m|)) - ('T (|objNew| |code| |m|)))) + (mkObjWrap (|timedEVALFUN| |code|) |m|)) + ('T (mkObj |code| |m|)))) (COND ((SPADLET |val1| (|coerceInteractive| |val| (OR |tar| |m|))) @@ -4221,8 +4221,8 @@ There are several special modes used in these functions: (SPADLET |val| (COND (|$genValue| - (|objNewWrap| (|timedEVALFUN| |code|) |m|)) - ('T (|objNew| |code| |m|)))) + (mkObjWrap (|timedEVALFUN| |code|) |m|)) + ('T (mkObj |code| |m|)))) (COND (|tar| (SPADLET |val1| (|coerceInteractive| |val| |tar|))) @@ -4285,8 +4285,8 @@ There are several special modes used in these functions: (SPADLET |val| (COND (|$genValue| - (|objNewWrap| (|timedEVALFUN| |code|) |m|)) - ('T (|objNew| |code| |m|)))) + (mkObjWrap (|timedEVALFUN| |code|) |m|)) + ('T (mkObj |code| |m|)))) (COND (|tar| (SPADLET |val1| (|coerceInteractive| |val| |tar|))) @@ -4385,7 +4385,7 @@ There are several special modes used in these functions: (NULL (|isPartialMode| |b|))) (CONS '|List| (CONS |b| NIL))) ('T '(|List| (|None|))))) - (SPADLET |val| (|objNewWrap| NIL |defMode|)) + (SPADLET |val| (mkObjWrap NIL |defMode|)) (COND ((AND |tar| (NULL (|isPartialMode| |tar|))) (COND @@ -4502,7 +4502,7 @@ There are several special modes used in these functions: (COND (|$genValue| (SPADLET |code| (|wrap| (|timedEVALFUN| |code|))))) - (|putValue| |op| (|objNew| |code| |tar|)) + (|putValue| |op| (mkObj |code| |tar|)) (|putModeSet| |op| (CONS |tar| NIL)))))))) ;--% Handlers for declarations @@ -4698,7 +4698,7 @@ There are several special modes used in these functions: NIL) (SEQ (EXIT (|declare| |var| |mode|))))) ('T (|declare| |lhs| |mode|)))) - (|putValue| |op| (|objNewWrap| (|voidValue|) |$Void|)) + (|putValue| |op| (mkObjWrap (|voidValue|) |$Void|)) (|putModeSet| |op| (CONS |$Void| NIL)))))))))) ;declare(var,mode) == diff --git a/src/interp/i-spec2.lisp.pamphlet b/src/interp/i-spec2.lisp.pamphlet index 6933b4e..63f11f1 100644 --- a/src/interp/i-spec2.lisp.pamphlet +++ b/src/interp/i-spec2.lisp.pamphlet @@ -111,7 +111,7 @@ There are several special modes used in these functions: NIL)))) ('T (SPADLET |mapOp| (CAR |mapOp|)))))) (|put| |mapOp| '|value| |v| |$e|) - (|putValue| |op| (|objNew| (|voidValue|) |$Void|)) + (|putValue| |op| (mkObj (|voidValue|) |$Void|)) (|putModeSet| |op| (CONS |$Void| NIL))))))))) ;--% Handler for package calling and $ constants @@ -240,7 +240,7 @@ There are several special modes used in these functions: (CONS 'LIST (CONS (MKQ |f|) NIL)) (CONS (MKQ |t|) NIL)))))) - (|putValue| |op| (|objNew| |val| |t|)) + (|putValue| |op| (mkObj |val| |t|)) (|putModeSet| |op| (CONS |t| NIL))))) ('T (SPADLET |nargs| (|#| (CDR |form|))) (COND @@ -429,7 +429,7 @@ There are several special modes used in these functions: (|$genValue| (|wrap| (|timedEVALFUN| |code|))) ('T |code|))) (SPADLET |rt| '(|SExpression|)) - (|putValue| |op| (|objNew| |code| |rt|)) + (|putValue| |op| (mkObj |code| |rt|)) (|putModeSet| |op| (CONS |rt| NIL))))))) ;--% Handlers for equation @@ -509,7 +509,7 @@ There are several special modes used in these functions: (DEFUN |upfree| (|t|) (declare (special |$Void|)) (PROGN - (|putValue| |t| (|objNew| '(|voidValue|) |$Void|)) + (|putValue| |t| (mkObj '(|voidValue|) |$Void|)) (|putModeSet| |t| (CONS |$Void| NIL)))) ;uplocal t == @@ -519,7 +519,7 @@ There are several special modes used in these functions: (DEFUN |uplocal| (|t|) (declare (special |$Void|)) (PROGN - (|putValue| |t| (|objNew| '(|voidValue|) |$Void|)) + (|putValue| |t| (mkObj '(|voidValue|) |$Void|)) (|putModeSet| |t| (CONS |$Void| NIL)))) ;upfreeWithType(var,type) == @@ -599,7 +599,7 @@ There are several special modes used in these functions: (COND (|$genValue| (SPADLET |code| (|wrap| (|timedEVALFUN| |code|))))) - (|putValue| |op| (|objNew| |code| |$Boolean|)) + (|putValue| |op| (mkObj |code| |$Boolean|)) (|putModeSet| |op| (CONS |$Boolean| NIL))))))) ;--hasTest(a,b) == @@ -776,7 +776,7 @@ There are several special modes used in these functions: (CONS (CONS (|getArgValue| |cond| |$Boolean|) (CONS (|genIFvalCode| |a| |m|) NIL)) |elseCode|))) - (SPADLET |triple| (|objNew| |code| |m|)) + (SPADLET |triple| (mkObj |code| |m|)) (|putValue| |op| |triple|))))) ;genIFvalCode(t,m) == @@ -859,7 +859,7 @@ There are several special modes used in these functions: ((BOOT-EQUAL |m| |$Void|) |code|) ((SPADLET |code'| (|coerceInteractive| - (|objNew| (|quote2Wrapped| |code|) |m1|) |m|)) + (mkObj (|quote2Wrapped| |code|) |m1|) |m|)) (|wrapped2Quote| (|objVal| |code'|))) ('T (|throwKeyedMsgCannotCoerceWithValue| @@ -893,7 +893,7 @@ There are several special modes used in these functions: (COND ((|objValUnwrap| |val|) (|upIFgenValue| |op| |a|)) ((EQ |b| '|noBranch|) - (|putValue| |op| (|objNew| (|voidValue|) |$Void|)) + (|putValue| |op| (mkObj (|voidValue|) |$Void|)) (|putModeSet| |op| (CONS |$Void| NIL))) ('T (|upIFgenValue| |op| |b|)))) ('T (|throwKeyedMsg| 'S2IS0031 NIL))))))) @@ -1095,9 +1095,9 @@ There are several special modes used in these functions: (SPADLET |triple| (COND (|$genValue| - (|objNewWrap| (|timedEVALFUN| |code|) + (mkObjWrap (|timedEVALFUN| |code|) |$Boolean|)) - ('T (|objNew| |code| |$Boolean|)))) + ('T (mkObj |code| |$Boolean|)))) (|putValue| |op| |triple|))))) ;isLocalPred pattern == @@ -1280,7 +1280,7 @@ There are several special modes used in these functions: NIL)) NIL) (SEQ (EXIT (|evalLETchangeValue| |id| - (|objNewWrap| |value| + (mkObjWrap |value| (|get| |id| '|mode| |$env|)))))) 'T) ('T NIL))))))) @@ -1492,7 +1492,7 @@ There are several special modes used in these functions: (COND (|$genValue| (THROW (|eval| |$repeatBodyLabel|) (|voidValue|))) - ('T (|putValue| |t| (|objNew| |code| |$Void|)) + ('T (|putValue| |t| (mkObj |code| |$Void|)) (|putModeSet| |t| (CONS |$Void| NIL))))))))) ;--% Handler for break @@ -1524,7 +1524,7 @@ There are several special modes used in these functions: (CONS |$repeatLabel| (CONS '(|voidValue|) NIL)))) (COND (|$genValue| (THROW (|eval| |$repeatLabel|) (|voidValue|))) - ('T (|putValue| |op| (|objNew| |code| |$Void|)) + ('T (|putValue| |op| (mkObj |code| |$Void|)) (|putModeSet| |op| (CONS |$Void| NIL))))))))) ;--% Handlers for LET @@ -1735,7 +1735,7 @@ There are several special modes used in these functions: (COND (|$genValue| |v|) ('T - (|objNew| (|wrapped2Quote| (|objVal| |v|)) + (mkObj (|wrapped2Quote| (|objVal| |v|)) (|objMode| |v|))))) (|evalLETput| |lhs| |v|)) ('T (SPADLET |t1| (|objMode| |v|)) @@ -1746,7 +1746,7 @@ There are several special modes used in these functions: (COND (|$genValue| |v|) ('T - (|objNew| (|wrapped2Quote| (|objVal| |v|)) + (mkObj (|wrapped2Quote| (|objVal| |v|)) (|objMode| |v|))))) ('T (COND @@ -1783,7 +1783,7 @@ There are several special modes used in these functions: (CONS |t2| NIL))))) ('T (AND |t2| - (|objNew| + (mkObj (COND (|$genValue| (|wrap| (|timedEVALFUN| |v|))) @@ -1870,14 +1870,14 @@ There are several special modes used in these functions: (CONS (CONS '|evalLETchangeValue| (CONS (MKQ |name|) (CONS - (|objNewCode| + (mkObjCode (CONS '|wrap| (CONS (|objVal| |value|) NIL)) (|objMode| |value|)) NIL))) NIL))))))) - (SPADLET |value| (|objNew| |code| (|objMode| |value|))) + (SPADLET |value| (mkObj |code| (|objMode| |value|))) (COND ((|isLocalVar| |name|) (COND @@ -1949,7 +1949,7 @@ There are several special modes used in these functions: NIL)) (CONS (CONS ''T (CONS |failCode| NIL)) NIL)))) - (|putValue| |op| (|objNew| |code| |m|)))) + (|putValue| |op| (mkObj |code| |m|)))) (|putModeSet| |op| (CONS |m| NIL)))))) ;evalLETchangeValue(name,value) == @@ -2348,7 +2348,7 @@ There are several special modes used in these functions: (|$genValue| |r|) ('T (SPADLET |t| (|getValue| |op|)) (|putValue| |op| - (|objNew| + (mkObj (CONS 'PROGN (CONS |tableCode| (CONS (|objVal| |t|) NIL))) @@ -2480,7 +2480,7 @@ There are several special modes used in these functions: ((|categoryForm?| |type|) '(|SubDomain| (|Domain|))) ('T '(|Domain|)))) - (SPADLET |val| (|objNew| |type| |mode|)) + (SPADLET |val| (mkObj |type| |mode|)) (COND ((|isLocalVar| |opName|) (|put| |opName| '|value| |val| |$env|)) @@ -2505,7 +2505,7 @@ There are several special modes used in these functions: ((SPADLET |val| (|get| |symbol| '|value| |$e|)) NIL) ('T (SPADLET |obj| - (|objNew| (|wrap| |value|) (|devaluate| |domain|))) + (mkObj (|wrap| |value|) (|devaluate| |domain|))) (|put| |symbol| '|value| |obj| |$e|) 'T))))) ;--% Handler for Interpreter Macros @@ -2647,8 +2647,8 @@ There are several special modes used in these functions: (SPADLET |expr| (CAR G167484)) (SPADLET |triple| (COND - (|$genValue| (|objNewWrap| |expr| |m|)) - ('T (|objNew| (CONS 'QUOTE (CONS |expr| NIL)) |m|)))) + (|$genValue| (mkObjWrap |expr| |m|)) + ('T (mkObj (CONS 'QUOTE (CONS |expr| NIL)) |m|)))) (|putValue| |op| |triple|))))) ;--% Handler for pretend @@ -2684,7 +2684,7 @@ There are several special modes used in these functions: (|throwKeyedMsg| 'S2IE0004 (CONS |mode| NIL))) ('T (|bottomUp| |expr|) (|putValue| |op| - (|objNew| (|objVal| (|getValue| |expr|)) |mode|)) + (mkObj (|objVal| (|getValue| |expr|)) |mode|)) (|putModeSet| |op| (CONS |mode| NIL))))))))) ;--% Handlers for REDUCE @@ -2733,14 +2733,14 @@ There are several special modes used in these functions: (SPADLET |args| (CONS (SPADLET |arg| (|mkAtreeNode| |var|)) (CONS |arg| NIL))) - (|putValue| |arg| (|objNewWrap| |var| |type|))) + (|putValue| |arg| (mkObjWrap |var| |type|))) ('T (SPADLET |args| (CONS (SPADLET |arg| (|mkAtreeNode| '%1)) (CONS |arg| NIL))) (COND ((BOOT-EQUAL |type| |$Symbol|) - (|putValue| |arg| (|objNewWrap| '%1 |$Symbol|))) + (|putValue| |arg| (mkObjWrap '%1 |$Symbol|))) ('T NIL)))) (|putModeSet| |arg| (CONS |type| NIL)) (SPADLET |vecOp| (|mkAtreeNode| |op|)) @@ -3300,8 +3300,8 @@ There are several special modes used in these functions: (SPADLET |val| (COND (|$genValue| (|timedEVALFUN| |code|) - (|objNewWrap| (|voidValue|) |repeatMode|)) - ('T (|objNew| |code| |repeatMode|)))) + (mkObjWrap (|voidValue|) |repeatMode|)) + ('T (mkObj |code| |repeatMode|)))) (|putValue| |op| |val|)))))) ;interpOnlyREPEAT t == @@ -3372,7 +3372,7 @@ There are several special modes used in these functions: NIL)))) (SPADCATCH (|eval| |$repeatLabel|) (|timedEVALFUN| |code|)) - (SPADLET |val| (|objNewWrap| (|voidValue|) |repeatMode|)) + (SPADLET |val| (mkObjWrap (|voidValue|) |repeatMode|)) (|putValue| |op| |val|) (|putModeSet| |op| (CONS |repeatMode| NIL))))))) @@ -3424,7 +3424,7 @@ There are several special modes used in these functions: (PROGN (SETQ |type| (CAR G168105)) NIL)) NIL) (SEQ (EXIT (|put| |i| '|value| - (|objNewWrap| |val| |type|) |$env|)))) + (mkObjWrap |val| |type|) |$env|)))) (|bottomUp| |exp|) (SPADLET |v| (|getValue| |exp|)) (SPADLET |val| @@ -3490,10 +3490,10 @@ There are several special modes used in these functions: (SPADLET |$mapThrowCount| (PLUS |$mapThrowCount| 1)) (COND (|$genValue| - (THROW |cn| (|objNewWrap| (|removeQuote| |val'|) |m|))) + (THROW |cn| (mkObjWrap (|removeQuote| |val'|) |m|))) ('T (|putValue| |op| - (|objNew| + (mkObj (CONS 'THROW (CONS (MKQ |cn|) (CONS |val'| NIL))) |m|)) (|putModeSet| |op| (CONS |$Exit| NIL))))))))) @@ -3602,7 +3602,7 @@ There are several special modes used in these functions: ('T (CONS 'PROGN (REVERSE |bodyCode|))))) - (|objNew| |code| |m|))))) + (mkObj |code| |m|))))) (|putValue| |op| |val|)))))) ;--% Handlers for Tuple @@ -3783,8 +3783,8 @@ There are several special modes used in these functions: (SPADLET |val| (COND (|$genValue| - (|objNewWrap| (|timedEVALFUN| |code|) |m|)) - ('T (|objNew| |code| |m|)))) + (mkObjWrap (|timedEVALFUN| |code|) |m|)) + ('T (mkObj |code| |m|)))) (COND (|tar| (SPADLET |val1| (|coerceInteractive| |val| |tar|))) @@ -3830,7 +3830,7 @@ There are several special modes used in these functions: (NULL (|isPartialMode| |b|))) (CONS '|Tuple| (CONS |b| NIL))) ('T '(|Tuple| (|None|))))) - (SPADLET |val| (|objNewWrap| (|asTupleNew| 0 NIL) |defMode|)) + (SPADLET |val| (mkObjWrap (|asTupleNew| 0 NIL) |defMode|)) (COND ((AND |tar| (NULL (|isPartialMode| |tar|))) (COND @@ -3883,7 +3883,7 @@ There are several special modes used in these functions: (SPADLET |m| (CAR |LETTMP#1|)) |LETTMP#1|) ('T NIL)) (SPADLET |t| (|typeOfType| |m|)) - (|putValue| |op| (|objNew| |m| |t|)) + (|putValue| |op| (mkObj |m| |t|)) (|putModeSet| |op| (CONS |t| NIL))))))) ;typeOfType type == diff --git a/src/interp/interp-proclaims.lisp b/src/interp/interp-proclaims.lisp index 2264e82..979969b 100644 --- a/src/interp/interp-proclaims.lisp +++ b/src/interp/interp-proclaims.lisp @@ -2883,7 +2883,7 @@ BOOT::|addDmpLikeTermsAsTarget| VMLISP:HPUT* BOOT::|genMpFromDmpTerm| VMLISP:STRING2ID-N BOOT::|htMakeTemplates,substLabel| BOOT::|doDoitButton| - VMLISP:$FINDFILE BOOT::|keyedMsgCompFailure| BOOT::|objNew| + VMLISP:$FINDFILE BOOT::|keyedMsgCompFailure| BOOT::|putValue| BOOT::|getAtree| BOOT::|putModeSet| VMLISP:$SHOWLINE VMLISP:RDROPITEMS BOOT::|bottomUpType| BOOT::|bottomUpIdentifier| BOOT::|transferPropsToNode| @@ -3063,7 +3063,7 @@ BOOT::|addSuffix| BOOT::|processPackage,opt| BOOT::|subTree| BOOT::|mkRepititionAssoc,mkRepfun| BOOT::|setPackageLocals| BOOT::|UnionPrint| - BOOT::|JoinInner| BOOT::|objNewWrap| + BOOT::|JoinInner| BOOT::|coerceByFunction| BOOT::|MappingPrint| BOOT::|parseTypeEvaluateArgs| BOOT::|createEnum| BOOT::|parseTranCheckForRecord| BOOT::|installConstructor| @@ -3311,7 +3311,7 @@ BOOT::|printNamedStatsByProperty| BOOT::|Delay| BOOT::|initializeTimedNames| BOOT::|searchTailEnv| BOOT::|searchCurrentEnv| BOOT::|search| - BOOT::|e04ycfSolve,fc| BOOT::|insertWOC,fn| BOOT::|mkObj| + BOOT::|e04ycfSolve,fc| BOOT::|insertWOC,fn| VMLISP:|union| BOOT::|coerceInt| BOOT::|deleteAssocWOC| BOOT::|e04nafSolve,fa| BOOT::|deleteAssocWOC,fn| BOOT::|e04nafSolve,fb| BOOT::|deleteLassoc| BOOT::REMALIST @@ -3369,7 +3369,7 @@ BOOT::|formJoin1| BOOT::|app2StringWrap| BOOT:S- BOOT::|mkLessOrEqual| BOOT::|formArguments2String| BOOT::|putValueValue| BOOT::|asTupleNew| BOOT::|objSetVal| - BOOT::|objNewCode| FOAM-USER::H-ERROR BOOT::|displayRule| + FOAM-USER::H-ERROR BOOT::|displayRule| BOOT::|coerceInteractive| BOOT::|canMakeTuple| FOAM-USER::H-STRING BOOT:CARCDREXPAND BOOT::|formatOpSymbol| FOAM-USER::H-INTEGER diff --git a/src/interp/msgdb.lisp.pamphlet b/src/interp/msgdb.lisp.pamphlet index ed6f74e..9864383 100644 --- a/src/interp/msgdb.lisp.pamphlet +++ b/src/interp/msgdb.lisp.pamphlet @@ -1277,7 +1277,7 @@ (RETURN (COND ((NULL (SPADLET |val'| - (|coerceInteractive| (|mkObj| |val| |t1|) + (|coerceInteractive| (mkObj |val| |t1|) |$OutputForm|))) (|throwKeyedMsg| 'S2IC0002 (CONS |t1| (CONS |t2| NIL)))) ('T (SPADLET |val'| (|objValUnwrap| |val'|)) diff --git a/src/interp/slam.lisp.pamphlet b/src/interp/slam.lisp.pamphlet index 46e6927..401cecb 100644 --- a/src/interp/slam.lisp.pamphlet +++ b/src/interp/slam.lisp.pamphlet @@ -1179,7 +1179,7 @@ |$e|)) (SPADLET |$e| (|putHist| |x| '|value| - (|mkObj| |def| |$EmptyMode|) + (mkObj |def| |$EmptyMode|) |$e|)))) (COND ((SPADLET |cacheVec|