From d05164b7bc0d0998e9e220497386ff7d7cc9a445 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Mon, 26 Jul 2010 16:33:38 +0000 Subject: * interp/g-opt.boot ($VMsideEffectFreeOperators): Include new opcodes %icst0, %icst1, %when, and %ccst. * interp/g-util.boot: Expand %ccst. * algebra/alql.spad.pamphlet: Clean up. * algebra/array1.spad.pamphlet: Likewise. * algebra/c02.spad.pamphlet: Likewise. * algebra/d03.spad.pamphlet: Likewise. * algebra/e04.spad.pamphlet: Likewise. * algebra/integer.spad.pamphlet: Likewise. * algebra/si.spad.pamphlet: Likewise. * algebra/string.spad.pamphlet: Likewise. --- src/ChangeLog | 14 ++ src/algebra/alql.spad.pamphlet | 15 +- src/algebra/array1.spad.pamphlet | 8 +- src/algebra/c02.spad.pamphlet | 9 +- src/algebra/d03.spad.pamphlet | 11 +- src/algebra/e04.spad.pamphlet | 7 +- src/algebra/integer.spad.pamphlet | 84 +++++---- src/algebra/si.spad.pamphlet | 14 +- src/algebra/strap/CHAR.lsp | 12 +- src/algebra/strap/INT.lsp | 361 +++++++++++++++++++------------------- src/algebra/strap/ISTRING.lsp | 56 +++--- src/algebra/string.spad.pamphlet | 9 +- src/interp/g-opt.boot | 20 +-- src/interp/g-util.boot | 8 + 14 files changed, 334 insertions(+), 294 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 99244e0d..cd08dcdf 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,17 @@ +2010-07-26 Gabriel Dos Reis + + * interp/g-opt.boot ($VMsideEffectFreeOperators): Include new + opcodes %icst0, %icst1, %when, and %ccst. + * interp/g-util.boot: Expand %ccst. + * algebra/alql.spad.pamphlet: Clean up. + * algebra/array1.spad.pamphlet: Likewise. + * algebra/c02.spad.pamphlet: Likewise. + * algebra/d03.spad.pamphlet: Likewise. + * algebra/e04.spad.pamphlet: Likewise. + * algebra/integer.spad.pamphlet: Likewise. + * algebra/si.spad.pamphlet: Likewise. + * algebra/string.spad.pamphlet: Likewise. + 2010-07-26 Gabriel Dos Reis * algebra/si.spad.pamphlet (SingleInteger): Tidy. diff --git a/src/algebra/alql.spad.pamphlet b/src/algebra/alql.spad.pamphlet index 8625c4ca..38162c30 100644 --- a/src/algebra/alql.spad.pamphlet +++ b/src/algebra/alql.spad.pamphlet @@ -55,6 +55,7 @@ IndexCard() : Exports == Implementation where ++ \axiom{s} is not of the right format then an error will occur when using ++ it. Implementation == add + macro I == Integer Rep == String x empty() hconcat(" if ",condition::OutputForm) @@ -89,14 +90,14 @@ IndexCard() : Exports == Implementation where elt(x,sel) == sel = 'name => dbName(x)$Lisp - sel = 'nargs => dbPart(x,2,1$Lisp)$Lisp + sel = 'nargs => dbPart(x,2,1@I)$Lisp sel = 'exposed => SUBSTRING(dbPart(x,3,1)$Lisp,0,1)$Lisp - sel = 'type => dbPart(x,4,1$Lisp)$Lisp - sel = 'abbreviation => dbPart(x,5,1$Lisp)$Lisp + sel = 'type => dbPart(x,4,1@I)$Lisp + sel = 'abbreviation => dbPart(x,5,1@I)$Lisp sel = 'kind => alqlGetKindString(x)$Lisp sel = 'origin => alqlGetOrigin(x)$Lisp sel = 'params => alqlGetParams(x)$Lisp - sel = 'condition => dbPart(x,6,1$Lisp)$Lisp + sel = 'condition => dbPart(x,6,1@I)$Lisp sel = 'doc => dbComments(x)$Lisp userError "unknown selector" diff --git a/src/algebra/array1.spad.pamphlet b/src/algebra/array1.spad.pamphlet index 0d4257e8..7eb4c367 100644 --- a/src/algebra/array1.spad.pamphlet +++ b/src/algebra/array1.spad.pamphlet @@ -15,8 +15,10 @@ ++ This provides a fast array type with no bound checking on elt's. ++ Minimum index is 0 in this type, cannot be changed PrimitiveArray(S:Type): OneDimensionalArrayAggregate S == add + macro NNI == NonNegativeInteger import %vlength: % -> NonNegativeInteger from Foreign Builtin import %vref: (%,Integer) -> S from Foreign Builtin + import makeSimpleArray: (Domain,NNI) -> % from Foreign Builtin #x == %vlength x @@ -24,7 +26,7 @@ PrimitiveArray(S:Type): OneDimensionalArrayAggregate S == add 0 empty() == - makeSimpleArray(getVMType(S)$Lisp,0$Lisp)$Lisp + makeSimpleArray(getVMType(S)$Lisp,0) construct l == makeSimpleArrayFromList(getVMType(S)$Foreign(Builtin),l)$Foreign(Builtin) @@ -429,12 +431,12 @@ IndexedOneDimensionalArray(S:Type, mn:Integer): qsetelt!(x, i, s) == Qsetelt(x, i-1, s) elt(x:%, i:I) == - QSLESSP(i,1$Lisp)$Lisp or QSLESSP(%vlength x,i)$Lisp => + QSLESSP(i,1@I)$Lisp or QSLESSP(%vlength x,i)$Lisp => error "index out of range" %vref(x, i-1) setelt(x:%, i:I, s:S) == - QSLESSP(i,1$Lisp)$Lisp or QSLESSP(%vlength x,i)$Lisp => + QSLESSP(i,1@I)$Lisp or QSLESSP(%vlength x,i)$Lisp => error "index out of range" Qsetelt(x, i-1, s) diff --git a/src/algebra/c02.spad.pamphlet b/src/algebra/c02.spad.pamphlet index 87e2adc1..f20f2e9f 100644 --- a/src/algebra/c02.spad.pamphlet +++ b/src/algebra/c02.spad.pamphlet @@ -48,6 +48,7 @@ NagPolynomialRootsPackage(): Exports == Implementation where import AnyFunctions1(Matrix DoubleFloat) import AnyFunctions1(Integer) import AnyFunctions1(Boolean) + macro I == Integer c02aff(aArg:Matrix DoubleFloat,nArg:Integer,scaleArg:Boolean,_ @@ -56,8 +57,8 @@ NagPolynomialRootsPackage(): Exports == Implementation where "c02aff",_ ["n"::S,"scale"::S,"ifail"::S,"a"::S,"z"::S,"w"::S]$Lisp,_ ["z"::S,"w"::S]$Lisp,_ - [["double"::S,["a"::S,2$Lisp,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp_ - ,["z"::S,2$Lisp,"n"::S]$Lisp,["w"::S,["*"::S,["+"::S,"n"::S,1$Lisp]$Lisp,4$Lisp]$Lisp]$Lisp]$Lisp_ + [["double"::S,["a"::S,2$Lisp,["+"::S,"n"::S,1@I]$Lisp]$Lisp_ + ,["z"::S,2$Lisp,"n"::S]$Lisp,["w"::S,["*"::S,["+"::S,"n"::S,1@I]$Lisp,4$Lisp]$Lisp]$Lisp]$Lisp_ ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ ,["logical"::S,"scale"::S]$Lisp_ ]$Lisp,_ @@ -74,8 +75,8 @@ NagPolynomialRootsPackage(): Exports == Implementation where "c02agf",_ ["n"::S,"scale"::S,"ifail"::S,"a"::S,"z"::S,"w"::S]$Lisp,_ ["z"::S,"w"::S]$Lisp,_ - [["double"::S,["a"::S,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp_ - ,["z"::S,2$Lisp,"n"::S]$Lisp,["w"::S,["*"::S,["+"::S,"n"::S,1$Lisp]$Lisp,2$Lisp]$Lisp]$Lisp]$Lisp_ + [["double"::S,["a"::S,["+"::S,"n"::S,1@I]$Lisp]$Lisp_ + ,["z"::S,2$Lisp,"n"::S]$Lisp,["w"::S,["*"::S,["+"::S,"n"::S,1@I]$Lisp,2$Lisp]$Lisp]$Lisp]$Lisp_ ,["integer"::S,"n"::S,"ifail"::S]$Lisp_ ,["logical"::S,"scale"::S]$Lisp_ ]$Lisp,_ diff --git a/src/algebra/d03.spad.pamphlet b/src/algebra/d03.spad.pamphlet index 58e36538..81aca02b 100644 --- a/src/algebra/d03.spad.pamphlet +++ b/src/algebra/d03.spad.pamphlet @@ -64,6 +64,7 @@ NagPartialDifferentialEquationsPackage(): Exports == Implementation where import FortranPackage import Union(fn:FileName,fp:Asp73(PDEF)) import Union(fn:FileName,fp:Asp74(BNDY)) + macro I == Integer @@ -136,11 +137,11 @@ NagPartialDifferentialEquationsPackage(): Exports == Implementation where ,"lwrk"::S,"pertrb"::S,"ifail"::S,"bdxs"::S,"bdxf"::S,"bdys"::S,"bdyf"::S,"bdzs"::S_ ,"bdzf"::S,"f"::S,"w"::S]$Lisp,_ ["pertrb"::S,"w"::S]$Lisp,_ - [["double"::S,"xs"::S,"xf"::S,["bdxs"::S,"mdimf"::S,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp_ - ,["bdxf"::S,"mdimf"::S,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp,"ys"::S,"yf"::S,["bdys"::S,"ldimf"::S,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp_ - ,["bdyf"::S,"ldimf"::S,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp,"zs"::S_ - ,"zf"::S,["bdzs"::S,"ldimf"::S,["+"::S,"m"::S,1$Lisp]$Lisp]$Lisp,["bdzf"::S,"ldimf"::S,["+"::S,"m"::S,1$Lisp]$Lisp]$Lisp_ - ,"lambda"::S,"pertrb"::S,["f"::S,"ldimf"::S,"mdimf"::S,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp,["w"::S,"lwrk"::S]$Lisp]$Lisp_ + [["double"::S,"xs"::S,"xf"::S,["bdxs"::S,"mdimf"::S,["+"::S,"n"::S,1@I]$Lisp]$Lisp_ + ,["bdxf"::S,"mdimf"::S,["+"::S,"n"::S,1@I]$Lisp]$Lisp,"ys"::S,"yf"::S,["bdys"::S,"ldimf"::S,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp_ + ,["bdyf"::S,"ldimf"::S,["+"::S,"n"::S,1@I]$Lisp]$Lisp,"zs"::S_ + ,"zf"::S,["bdzs"::S,"ldimf"::S,["+"::S,"m"::S,1@I]$Lisp]$Lisp,["bdzf"::S,"ldimf"::S,["+"::S,"m"::S,1$Lisp]$Lisp]$Lisp_ + ,"lambda"::S,"pertrb"::S,["f"::S,"ldimf"::S,"mdimf"::S,["+"::S,"n"::S,1@I]$Lisp]$Lisp,["w"::S,"lwrk"::S]$Lisp]$Lisp_ ,["integer"::S,"l"::S,"lbdcnd"::S,"m"::S,"mbdcnd"::S_ ,"n"::S,"nbdcnd"::S,"ldimf"::S,"mdimf"::S,"lwrk"::S,"ifail"::S]$Lisp_ ]$Lisp,_ diff --git a/src/algebra/e04.spad.pamphlet b/src/algebra/e04.spad.pamphlet index bae05dee..df9853f8 100644 --- a/src/algebra/e04.spad.pamphlet +++ b/src/algebra/e04.spad.pamphlet @@ -115,6 +115,7 @@ NagOptimisationPackage(): Exports == Implementation where import AnyFunctions1(Boolean) import AnyFunctions1(Matrix DoubleFloat) import AnyFunctions1(Matrix Integer) + macro I == Integer e04dgf(nArg:Integer,esArg:DoubleFloat,fuArg:DoubleFloat,_ @@ -139,7 +140,7 @@ NagOptimisationPackage(): Exports == Implementation where ,"op"::S,"objf"::S,["objgrd"::S,"n"::S]$Lisp,["x"::S,"n"::S]$Lisp,["work"::S,["*"::S,13$Lisp,"n"::S]$Lisp]$Lisp,["user"::S,"*"::S]$Lisp_ ,"objfun"::S]$Lisp_ ,["integer"::S,"n"::S,"it"::S,"pr"::S,"sta"::S_ - ,"sto"::S,"ve"::S,"iter"::S,"ifail"::S,["iwork"::S,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp,["iuser"::S,"*"::S]$Lisp]$Lisp_ + ,"sto"::S,"ve"::S,"iter"::S,"ifail"::S,["iwork"::S,["+"::S,"n"::S,1@I]$Lisp]$Lisp,["iuser"::S,"*"::S]$Lisp]$Lisp_ ,["logical"::S,"list"::S]$Lisp_ ]$Lisp,_ ["iter"::S,"objf"::S,"objgrd"::S,"x"::S,"ifail"::S]$Lisp,_ @@ -321,11 +322,11 @@ NagOptimisationPackage(): Exports == Implementation where ,"cra"::S,"fea"::S,"fun"::S,"infb"::S,"infs"::S,"linf"::S,"lint"::S,"nonf"::S,"opt"::S,"ste"::S_ ,["c"::S,"ncnln"::S]$Lisp,"objf"::S,["objgrd"::S,"n"::S]$Lisp,["cjac"::S,"nrowj"::S,"n"::S]$Lisp,["clamda"::S,["+"::S,["+"::S,"nclin"::S,"ncnln"::S]$Lisp,"n"::S]$Lisp]$Lisp_ ,["r"::S,"nrowr"::S,"n"::S]$Lisp,["x"::S,"n"::S]$Lisp,["work"::S,"lwork"::S]$Lisp_ - ,["user"::S,1$Lisp]$Lisp,"confun"::S,"objfun"::S]$Lisp_ + ,["user"::S,1@I]$Lisp,"confun"::S,"objfun"::S]$Lisp_ ,["integer"::S,"n"::S,"nclin"::S,"ncnln"::S_ ,"nrowa"::S,"nrowj"::S,"nrowr"::S,"liwork"::S,"lwork"::S,"der"::S,"maji"::S,"majp"::S,"mini"::S,"minp"::S,"mon"::S,"stao"::S_ ,"stac"::S,"stoo"::S,"stoc"::S,"ve"::S,"iter"::S,["istate"::S,["+"::S,["+"::S,"nclin"::S,"ncnln"::S]$Lisp,"n"::S]$Lisp]$Lisp_ - ,"ifail"::S,["iwork"::S,"liwork"::S]$Lisp,["iuser"::S,1$Lisp]$Lisp]$Lisp_ + ,"ifail"::S,["iwork"::S,"liwork"::S]$Lisp,["iuser"::S,1@I]$Lisp]$Lisp_ ,["logical"::S,"sta"::S,"hes"::S,"list"::S]$Lisp_ ]$Lisp,_ ["iter"::S,"c"::S,"objf"::S,"objgrd"::S,"istate"::S,"cjac"::S,"clamda"::S,"r"::S,"x"::S,"ifail"::S]$Lisp,_ diff --git a/src/algebra/integer.spad.pamphlet b/src/algebra/integer.spad.pamphlet index da23d678..9685c43d 100644 --- a/src/algebra/integer.spad.pamphlet +++ b/src/algebra/integer.spad.pamphlet @@ -82,17 +82,29 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with == add ZP ==> SparseUnivariatePolynomial % ZZP ==> SparseUnivariatePolynomial Integer + import %icst0: % from Foreign Builtin + import %icst1: % from Foreign Builtin import %ineg: % -> % from Foreign Builtin + import %iabs: % -> % from Foreign Builtin + import %iodd?: % -> Boolean from Foreign Builtin import %hash: % -> SingleInteger from Foreign Builtin import %iadd: (%,%) -> % from Foreign Builtin import %isub: (%,%) -> % from Foreign Builtin import %imul: (%,%) -> % from Foreign Builtin + import %imax: (%,%) -> % from Foreign Builtin + import %imin: (%,%) -> % from Foreign Builtin + import %igcd: (%,%) -> % from Foreign Builtin + import %ieq: (%,%) -> Boolean from Foreign Builtin + import %ilt: (%,%) -> Boolean from Foreign Builtin + import %ile: (%,%) -> Boolean from Foreign Builtin + import %igt: (%,%) -> Boolean from Foreign Builtin + import %ige: (%,%) -> Boolean from Foreign Builtin x,y: % n: NonNegativeInteger writeOMInt(dev: OpenMathDevice, x: %): Void == - if x < 0 then + if negative? x then OMputApp(dev) OMputSymbol(dev, "arith1", "unary__minus") OMputInteger(dev, (-x) pretend Integer) @@ -102,27 +114,25 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with OMwrite(x: %): String == s: String := "" - sp := OM_-STRINGTOSTRINGPTR(s)$Lisp - dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML()) + sp: String := OM_-STRINGTOSTRINGPTR(s)$Lisp + dev: OpenMathDevice := OMopenString(sp, OMencodingXML()) OMputObject(dev) writeOMInt(dev, x) OMputEndObject(dev) OMclose(dev) - s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String - s + OM_-STRINGPTRTOSTRING(sp)$Lisp OMwrite(x: %, wholeObj: Boolean): String == s: String := "" - sp := OM_-STRINGTOSTRINGPTR(s)$Lisp - dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML()) + sp: String := OM_-STRINGTOSTRINGPTR(s)$Lisp + dev: OpenMathDevice := OMopenString(sp, OMencodingXML()) if wholeObj then OMputObject(dev) writeOMInt(dev, x) if wholeObj then OMputEndObject(dev) OMclose(dev) - s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String - s + OM_-STRINGPTRTOSTRING(sp)$Lisp OMwrite(dev: OpenMathDevice, x: %): Void == OMputObject(dev) @@ -136,34 +146,36 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with if wholeObj then OMputEndObject(dev) - zero? x == ZEROP(x)$Lisp - one? x == x = 1 - 0 == 0$Lisp - 1 == 1$Lisp - base() == 2$Lisp + zero? x == x = 0@% + one? x == x = 1@% + 0 == %icst0 + 1 == %icst1 + base() == 2 pretend % copy x == x - inc x == x + 1 - dec x == x - 1 + inc x == x + 1@% + dec x == x - 1@% hash x == %hash x - negative? x == x < 0 + negative? x == x < 0@% 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 := %iadd(a,b)) >= p => c - p + c := %iadd(a,b) + c >= p => c - p c submod(a, b, p) == - (c := %isub(a,b)) < 0 => c + p + c := %isub(a,b) + negative? c => c + p c mulmod(a, b, p) == %imul(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 + convert(x:%):Float == coerce(x)$Float + convert(x:%):DoubleFloat == coerce(x)$DoubleFloat + convert(x:%):InputForm == convert(x)$InputForm + convert(x:%):String == string(x)$String latex(x:%):String == - s : String := string(x pretend Integer)$String + s : String := string(x)$String (-1 < (x pretend Integer)) and ((x pretend Integer) < 10) => s concat("{", concat(s, "}")$String)$String @@ -180,33 +192,33 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with Record(mat:Matrix(Integer), vec:Vector(Integer)) == [m pretend Matrix(Integer), vec pretend Vector(Integer)] - abs(x) == %iabs(x)$Foreign(Builtin) + abs(x) == %iabs x random() == random()$Lisp random(x) == RANDOM(x)$Lisp - x = y == %ieq(x,y)$Foreign(Builtin) - x < y == %ilt(x,y)$Foreign(Builtin) - x > y == %igt(x,y)$Foreign(Builtin) - x <= y == %ile(x,y)$Foreign(Builtin) - x >= y == %ige(x,y)$Foreign(Builtin) + x = y == %ieq(x,y) + x < y == %ilt(x,y) + x > y == %igt(x,y) + x <= y == %ile(x,y) + x >= y == %ige(x,y) - x == %ineg x x + y == %iadd(x,y) x - y == %isub(x,y) x * y == %imul(x,y) (m:Integer) * (y:%) == %imul(m,y) -- for subsumption problem x ** n == %ipow(x,n)$Foreign(Builtin) - odd? x == %iodd?(x)$Foreign(Builtin) - max(x,y) == %imax(x,y)$Foreign(Builtin) - min(x,y) == %imin(x,y)$Foreign(Builtin) + odd? x == %iodd? x + max(x,y) == %imax(x,y) + min(x,y) == %imin(x,y) divide(x,y) == DIVIDE2(x,y)$Lisp x quo y == QUOTIENT2(x,y)$Lisp x rem y == REMAINDER2(x,y)$Lisp shift(x, y) == ASH(x,y)$Lisp recip(x) == if one? x or x=-1 then x else "failed" - gcd(x,y) == %igcd(x,y)$Foreign(Builtin) + gcd(x,y) == %igcd(x,y) UCA ==> Record(unit:%,canonical:%,associate:%) unitNormal x == - x < 0 => [-1,-x,-1]$UCA - [1,x,1]$UCA + negative? x => [-1@%,-x,-1@%]$UCA + [1@%,x,1@%]$UCA unitCanonical x == abs x solveLinearPolynomialEquation(lp:List ZP,p:ZP):Union(List ZP,"failed") == solveLinearPolynomialEquation(lp pretend List ZZP, diff --git a/src/algebra/si.spad.pamphlet b/src/algebra/si.spad.pamphlet index ee43e1dc..98fe1168 100644 --- a/src/algebra/si.spad.pamphlet +++ b/src/algebra/si.spad.pamphlet @@ -210,13 +210,6 @@ SingleInteger(): Join(IntegerNumberSystem,OrderedFinite,BooleanLogic,Logic,OpenM == SubDomain(Integer, SMINTP(#1)$Lisp) add - seed : % := 1$Lisp -- for random() - MAXINT ==> _$ShortMaximum$Lisp - MININT ==> _$ShortMinimum$Lisp - BASE ==> 67108864$Lisp -- 2**26 - MULTIPLIER ==> 314159269$Lisp -- from Knuth's table - MODULUS ==> 2147483647$Lisp -- 2**31-1 - import %icst0: % from Foreign Builtin import %icst1: % from Foreign Builtin import %iadd: (%,%) -> % from Foreign Builtin @@ -235,6 +228,13 @@ SingleInteger(): Join(IntegerNumberSystem,OrderedFinite,BooleanLogic,Logic,OpenM import %igt: (%,%) -> Boolean from Foreign Builtin import %ige: (%,%) -> Boolean from Foreign Builtin + seed : % := %icst1 -- for random() + MAXINT ==> _$ShortMaximum$Lisp + MININT ==> _$ShortMinimum$Lisp + BASE ==> 67108864$Lisp -- 2**26 + MULTIPLIER ==> 314159269$Lisp -- from Knuth's table + MODULUS ==> 2147483647$Lisp -- 2**31-1 + writeOMSingleInt(dev: OpenMathDevice, x: %): Void == if negative? x then OMputApp(dev) diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp index c43f36f7..7e15370a 100644 --- a/src/algebra/strap/CHAR.lsp +++ b/src/algebra/strap/CHAR.lsp @@ -51,15 +51,15 @@ (DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;space;$;12|)) -(PUT '|CHAR;space;$;12| '|SPADreplace| '(XLAM NIL (CHAR " " 0))) +(PUT '|CHAR;space;$;12| '|SPADreplace| '(XLAM NIL (|%ccst| " "))) (DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;quote;$;13|)) -(PUT '|CHAR;quote;$;13| '|SPADreplace| '(XLAM NIL (CHAR "\" " 0))) +(PUT '|CHAR;quote;$;13| '|SPADreplace| '(XLAM NIL (|%ccst| "\""))) (DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;escape;$;14|)) -(PUT '|CHAR;escape;$;14| '|SPADreplace| '(XLAM NIL (CHAR "_ " 0))) +(PUT '|CHAR;escape;$;14| '|SPADreplace| '(XLAM NIL (|%ccst| "_"))) (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Thing|) |CHAR;coerce;$Of;15|)) @@ -141,11 +141,11 @@ (DEFUN |CHAR;random;$;11| ($) (CODE-CHAR (RANDOM 256))) -(DEFUN |CHAR;space;$;12| ($) (DECLARE (IGNORE $)) (CHAR " " 0)) +(DEFUN |CHAR;space;$;12| ($) (DECLARE (IGNORE $)) #\Space) -(DEFUN |CHAR;quote;$;13| ($) (DECLARE (IGNORE $)) (CHAR "\" " 0)) +(DEFUN |CHAR;quote;$;13| ($) (DECLARE (IGNORE $)) #\") -(DEFUN |CHAR;escape;$;14| ($) (DECLARE (IGNORE $)) (CHAR "_ " 0)) +(DEFUN |CHAR;escape;$;14| ($) (DECLARE (IGNORE $)) #\_) (DEFUN |CHAR;coerce;$Of;15| (|c| $) (DECLARE (IGNORE $)) |c|) diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp index 2da51e0e..2f9194a2 100644 --- a/src/algebra/strap/INT.lsp +++ b/src/algebra/strap/INT.lsp @@ -20,8 +20,6 @@ (DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Boolean|) |INT;zero?;$B;6|)) -(PUT '|INT;zero?;$B;6| '|SPADreplace| 'ZEROP) - (DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Boolean|) |INT;one?;$B;7|)) @@ -255,6 +253,8 @@ (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) |INT;gcdPolynomial;3Sup;60|)) +(PUT '|INT;zero?;$B;6| '|SPADreplace| '(XLAM (|x|) (|%ieq| |x| 0))) + (PUT '|INT;one?;$B;7| '|SPADreplace| '(XLAM (|x|) (|%ieq| |x| 1))) (PUT '|INT;inc;2$;12| '|SPADreplace| '(XLAM (|x|) (|%iadd| |x| 1))) @@ -269,43 +269,43 @@ (DEFUN |INT;writeOMInt| (|dev| |x| $) (SEQ (COND ((MINUSP |x|) - (SEQ (SPADCALL |dev| (|getShellEntry| $ 13)) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 10)) (SPADCALL |dev| "arith1" "unary_minus" - (|getShellEntry| $ 15)) - (SPADCALL |dev| (- |x|) (|getShellEntry| $ 18)) - (EXIT (SPADCALL |dev| (|getShellEntry| $ 19))))) - (T (SPADCALL |dev| |x| (|getShellEntry| $ 18)))))) + (|getShellEntry| $ 12)) + (SPADCALL |dev| (- |x|) (|getShellEntry| $ 15)) + (EXIT (SPADCALL |dev| (|getShellEntry| $ 16))))) + (T (SPADCALL |dev| |x| (|getShellEntry| $ 15)))))) (DEFUN |INT;OMwrite;$S;2| (|x| $) (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) - (|dev| (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 21)) - (|getShellEntry| $ 22)))) - (SEQ (SPADCALL |dev| (|getShellEntry| $ 23)) + (|dev| (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 18)) + (|getShellEntry| $ 19)))) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 20)) (|INT;writeOMInt| |dev| |x| $) - (SPADCALL |dev| (|getShellEntry| $ 24)) - (SPADCALL |dev| (|getShellEntry| $ 25)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) + (SPADCALL |dev| (|getShellEntry| $ 21)) + (SPADCALL |dev| (|getShellEntry| $ 22)) + (EXIT (OM-STRINGPTRTOSTRING |sp|))))) (DEFUN |INT;OMwrite;$BS;3| (|x| |wholeObj| $) (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) - (|dev| (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 21)) - (|getShellEntry| $ 22)))) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 23)))) + (|dev| (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 18)) + (|getShellEntry| $ 19)))) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 20)))) (|INT;writeOMInt| |dev| |x| $) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 24)))) - (SPADCALL |dev| (|getShellEntry| $ 25)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 21)))) + (SPADCALL |dev| (|getShellEntry| $ 22)) + (EXIT (OM-STRINGPTRTOSTRING |sp|))))) (DEFUN |INT;OMwrite;Omd$V;4| (|dev| |x| $) - (SEQ (SPADCALL |dev| (|getShellEntry| $ 23)) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 20)) (|INT;writeOMInt| |dev| |x| $) - (EXIT (SPADCALL |dev| (|getShellEntry| $ 24))))) + (EXIT (SPADCALL |dev| (|getShellEntry| $ 21))))) (DEFUN |INT;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) - (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 23)))) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 20)))) (|INT;writeOMInt| |dev| |x| $) (EXIT (COND - (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 24))))))) + (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 21))))))) (DEFUN |INT;zero?;$B;6| (|x| $) (DECLARE (IGNORE $)) (ZEROP |x|)) @@ -330,7 +330,7 @@ (MINUSP |x|)) (DEFUN |INT;coerce;$Of;16| (|x| $) - (SPADCALL |x| (|getShellEntry| $ 45))) + (SPADCALL |x| (|getShellEntry| $ 42))) (DEFUN |INT;coerce;2$;17| (|m| $) (DECLARE (IGNORE $)) |m|) @@ -351,14 +351,14 @@ (REMAINDER2 (* |a| |b|) |p|)) (DEFUN |INT;convert;$F;23| (|x| $) - (SPADCALL |x| (|getShellEntry| $ 56))) + (SPADCALL |x| (|getShellEntry| $ 53))) (DEFUN |INT;convert;$Df;24| (|x| $) (DECLARE (IGNORE $)) (FLOAT |x| |$DoubleFloatMaximum|)) (DEFUN |INT;convert;$If;25| (|x| $) - (SPADCALL |x| (|getShellEntry| $ 62))) + (SPADCALL |x| (|getShellEntry| $ 59))) (DEFUN |INT;convert;$S;26| (|x| $) (DECLARE (IGNORE $)) @@ -457,50 +457,50 @@ (ABS |x|)) (DEFUN |INT;solveLinearPolynomialEquation| (|lp| |p| $) - (SPADCALL |lp| |p| (|getShellEntry| $ 102))) + (SPADCALL |lp| |p| (|getShellEntry| $ 101))) (DEFUN |INT;squareFreePolynomial| (|p| $) - (SPADCALL |p| (|getShellEntry| $ 106))) + (SPADCALL |p| (|getShellEntry| $ 105))) (DEFUN |INT;factorPolynomial| (|p| $) - (LET ((|pp| (SPADCALL |p| (|getShellEntry| $ 107)))) + (LET ((|pp| (SPADCALL |p| (|getShellEntry| $ 106)))) (COND - ((EQL (SPADCALL |pp| (|getShellEntry| $ 108)) - (SPADCALL |p| (|getShellEntry| $ 108))) - (SPADCALL |p| (|getShellEntry| $ 110))) - (T (SPADCALL (SPADCALL |pp| (|getShellEntry| $ 110)) + ((EQL (SPADCALL |pp| (|getShellEntry| $ 107)) + (SPADCALL |p| (|getShellEntry| $ 107))) + (SPADCALL |p| (|getShellEntry| $ 109))) + (T (SPADCALL (SPADCALL |pp| (|getShellEntry| $ 109)) (SPADCALL (CONS #'|INT;factorPolynomial!0| $) (SPADCALL - (LET ((#0=#:G1499 + (LET ((#0=#:G1504 (SPADCALL (SPADCALL |p| - (|getShellEntry| $ 108)) + (|getShellEntry| $ 107)) (SPADCALL |pp| - (|getShellEntry| $ 108)) - (|getShellEntry| $ 112)))) + (|getShellEntry| $ 107)) + (|getShellEntry| $ 111)))) (|check-union| (ZEROP (CAR #0#)) $ #0#) (CDR #0#)) - (|getShellEntry| $ 114)) - (|getShellEntry| $ 118)) - (|getShellEntry| $ 120)))))) + (|getShellEntry| $ 113)) + (|getShellEntry| $ 117)) + (|getShellEntry| $ 119)))))) (DEFUN |INT;factorPolynomial!0| (|#1| $) - (SPADCALL |#1| (|getShellEntry| $ 111))) + (SPADCALL |#1| (|getShellEntry| $ 110))) (DEFUN |INT;factorSquareFreePolynomial| (|p| $) - (SPADCALL |p| (|getShellEntry| $ 121))) + (SPADCALL |p| (|getShellEntry| $ 120))) (DEFUN |INT;gcdPolynomial;3Sup;60| (|p| |q| $) (COND - ((SPADCALL |p| (|getShellEntry| $ 122)) - (SPADCALL |q| (|getShellEntry| $ 123))) - ((SPADCALL |q| (|getShellEntry| $ 122)) - (SPADCALL |p| (|getShellEntry| $ 123))) - (T (SPADCALL (LIST |p| |q|) (|getShellEntry| $ 126))))) + ((SPADCALL |p| (|getShellEntry| $ 121)) + (SPADCALL |q| (|getShellEntry| $ 122))) + ((SPADCALL |q| (|getShellEntry| $ 121)) + (SPADCALL |p| (|getShellEntry| $ 122))) + (T (SPADCALL (LIST |p| |q|) (|getShellEntry| $ 125))))) (DEFUN |Integer| () (DECLARE (SPECIAL |$ConstructorCache|)) - (PROG (#0=#:G1528) + (PROG (#0=#:G1536) (RETURN (COND ((SETQ #0# (HGET |$ConstructorCache| '|Integer|)) @@ -512,50 +512,49 @@ (COND ((NOT #0#) (HREM |$ConstructorCache| '|Integer|))))))))) (DEFUN |Integer;| () - (LET ((|dv$| (LIST '|Integer|)) ($ (|newShell| 141)) + (LET ((|dv$| (LIST '|Integer|)) ($ (|newShell| 140)) (|pv$| (|buildPredVector| 0 0 NIL))) (DECLARE (SPECIAL |$ConstructorCache|)) (|setShellEntry| $ 0 |dv$|) (|setShellEntry| $ 3 |pv$|) (|haddProp| |$ConstructorCache| '|Integer| NIL (CONS 1 $)) (|stuffDomainSlots| $) - (|setShellEntry| $ 83 - (|setShellEntry| $ 82 + (|setShellEntry| $ 82 + (|setShellEntry| $ 81 (CONS (|dispatchFunction| |INT;*;3$;43|) $))) $)) (MAKEPROP '|Integer| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL + (LIST '#(NIL NIL NIL NIL NIL NIL (|Boolean|) |INT;negative?;$B;15| + (|Void|) (|OpenMathDevice|) (0 . |OMputApp|) (|String|) + (5 . |OMputSymbol|) |INT;-;2$;39| (|Integer|) + (12 . |OMputInteger|) (18 . |OMputEndApp|) + (|OpenMathEncoding|) (23 . |OMencodingXML|) + (27 . |OMopenString|) (33 . |OMputObject|) + (38 . |OMputEndObject|) (43 . |OMclose|) + |INT;OMwrite;$S;2| |INT;OMwrite;$BS;3| + |INT;OMwrite;Omd$V;4| |INT;OMwrite;Omd$BV;5| (CONS IDENTITY (FUNCALL (|dispatchFunction| |INT;Zero;$;8|) $)) - (|NonNegativeInteger|) (0 . |Zero|) (|Boolean|) - |INT;<;2$B;35| (|Void|) (|OpenMathDevice|) - (4 . |OMputApp|) (|String|) (9 . |OMputSymbol|) - |INT;-;2$;39| (|Integer|) (16 . |OMputInteger|) - (22 . |OMputEndApp|) (|OpenMathEncoding|) - (27 . |OMencodingXML|) (31 . |OMopenString|) - (37 . |OMputObject|) (42 . |OMputEndObject|) - (47 . |OMclose|) |INT;OMwrite;$S;2| |INT;OMwrite;$BS;3| - |INT;OMwrite;Omd$V;4| |INT;OMwrite;Omd$BV;5| - |INT;zero?;$B;6| + |INT;=;2$B;34| |INT;zero?;$B;6| (CONS IDENTITY (FUNCALL (|dispatchFunction| |INT;One;$;9|) $)) - (52 . |One|) |INT;=;2$B;34| |INT;one?;$B;7| - |INT;base;$;10| |INT;copy;2$;11| |INT;+;3$;40| - |INT;inc;2$;12| |INT;-;3$;41| |INT;dec;2$;13| - (|SingleInteger|) |INT;hash;$Si;14| |INT;negative?;$B;15| - (|OutputForm|) (56 . |outputForm|) |INT;coerce;$Of;16| - |INT;coerce;2$;17| |INT;convert;2$;18| |INT;length;2$;19| - |INT;>=;2$B;38| |INT;addmod;4$;20| |INT;submod;4$;21| - |INT;rem;3$;50| |INT;mulmod;4$;22| (|Float|) - (61 . |coerce|) |INT;convert;$F;23| (|DoubleFloat|) - (66 . |coerce|) |INT;convert;$Df;24| (|InputForm|) - (71 . |convert|) |INT;convert;$If;25| (76 . |string|) - |INT;convert;$S;26| (81 . <) (87 . |concat|) - |INT;latex;$S;27| |INT;positiveRemainder;3$;28| - (|Matrix| 17) (|Matrix| $) |INT;reducedSystem;2M;29| - (|Vector| 17) (|Record| (|:| |mat| 70) (|:| |vec| 73)) - (|Vector| $) |INT;reducedSystem;MVR;30| |INT;abs;2$;31| + |INT;one?;$B;7| |INT;base;$;10| |INT;copy;2$;11| + |INT;+;3$;40| |INT;inc;2$;12| |INT;-;3$;41| + |INT;dec;2$;13| (|SingleInteger|) |INT;hash;$Si;14| + |INT;<;2$B;35| (|OutputForm|) (48 . |outputForm|) + |INT;coerce;$Of;16| |INT;coerce;2$;17| |INT;convert;2$;18| + |INT;length;2$;19| |INT;>=;2$B;38| |INT;addmod;4$;20| + |INT;submod;4$;21| |INT;rem;3$;50| |INT;mulmod;4$;22| + (|Float|) (53 . |coerce|) |INT;convert;$F;23| + (|DoubleFloat|) (58 . |coerce|) |INT;convert;$Df;24| + (|InputForm|) (63 . |convert|) |INT;convert;$If;25| + (68 . |string|) |INT;convert;$S;26| (|NonNegativeInteger|) + (73 . |One|) (77 . <) (83 . |concat|) |INT;latex;$S;27| + |INT;positiveRemainder;3$;28| (|Matrix| 14) (|Matrix| $) + |INT;reducedSystem;2M;29| (|Vector| 14) + (|Record| (|:| |mat| 69) (|:| |vec| 72)) (|Vector| $) + |INT;reducedSystem;MVR;30| |INT;abs;2$;31| |INT;random;$;32| |INT;random;2$;33| |INT;>;2$B;36| |INT;<=;2$B;37| NIL NIL |INT;**;$Nni$;44| |INT;odd?;$B;45| |INT;max;3$;46| |INT;min;3$;47| @@ -565,52 +564,52 @@ (|Record| (|:| |unit| $) (|:| |canonical| $) (|:| |associate| $)) |INT;unitNormal;$R;54| |INT;unitCanonical;2$;55| - (|SparseUnivariatePolynomial| 17) (|List| 98) - (|Union| 99 '"failed") + (|SparseUnivariatePolynomial| 14) (|List| 97) + (|Union| 98 '"failed") (|IntegerSolveLinearPolynomialEquation|) - (93 . |solveLinearPolynomialEquation|) - (|SparseUnivariatePolynomial| $$) (|Factored| 103) - (|UnivariatePolynomialSquareFree| $$ 103) - (99 . |squareFree|) (104 . |primitivePart|) - (109 . |leadingCoefficient|) (|GaloisGroupFactorizer| 103) - (114 . |factor|) (119 . |coerce|) (124 . |exquo|) - (|Factored| $) (130 . |factor|) (|Mapping| 103 $$) - (|Factored| $$) (|FactoredFunctions2| $$ 103) - (135 . |map|) (|FactoredFunctionUtilities| 103) - (141 . |mergeFactors|) (147 . |factorSquareFree|) - (152 . |zero?|) (157 . |unitCanonical|) (|List| 103) - (|HeuGcd| 103) (162 . |gcd|) + (89 . |solveLinearPolynomialEquation|) + (|SparseUnivariatePolynomial| $$) (|Factored| 102) + (|UnivariatePolynomialSquareFree| $$ 102) + (95 . |squareFree|) (100 . |primitivePart|) + (105 . |leadingCoefficient|) (|GaloisGroupFactorizer| 102) + (110 . |factor|) (115 . |coerce|) (120 . |exquo|) + (|Factored| $) (126 . |factor|) (|Mapping| 102 $$) + (|Factored| $$) (|FactoredFunctions2| $$ 102) + (131 . |map|) (|FactoredFunctionUtilities| 102) + (137 . |mergeFactors|) (143 . |factorSquareFree|) + (148 . |zero?|) (153 . |unitCanonical|) (|List| 102) + (|HeuGcd| 102) (158 . |gcd|) (|SparseUnivariatePolynomial| $) - |INT;gcdPolynomial;3Sup;60| (|Fraction| 17) - (|Union| 129 '"failed") (|Pattern| 17) - (|PatternMatchResult| 17 $) (|Union| 17 '"failed") - (|List| $) (|Record| (|:| |coef| 134) (|:| |generator| $)) - (|Union| 134 '"failed") + |INT;gcdPolynomial;3Sup;60| (|Fraction| 14) + (|Union| 128 '"failed") (|Pattern| 14) + (|PatternMatchResult| 14 $) (|Union| 14 '"failed") + (|List| $) (|Record| (|:| |coef| 133) (|:| |generator| $)) + (|Union| 133 '"failed") (|Record| (|:| |coef1| $) (|:| |coef2| $) (|:| |generator| $)) (|Record| (|:| |coef1| $) (|:| |coef2| $)) - (|Union| 138 '"failed") (|PositiveInteger|)) - '#(~= 167 |zero?| 173 |unitNormal| 178 |unitCanonical| 183 - |unit?| 188 |symmetricRemainder| 193 |subtractIfCan| 199 - |submod| 205 |squareFreePart| 212 |squareFree| 217 - |sizeLess?| 222 |sign| 228 |shift| 233 |sample| 239 - |retractIfCan| 243 |retract| 248 |rem| 253 |reducedSystem| - 259 |recip| 270 |rationalIfCan| 275 |rational?| 280 - |rational| 285 |random| 290 |quo| 299 |principalIdeal| 305 - |prime?| 310 |powmod| 315 |positiveRemainder| 322 - |positive?| 328 |permutation| 333 |patternMatch| 339 - |one?| 346 |odd?| 351 |nextItem| 356 |negative?| 361 - |multiEuclidean| 366 |mulmod| 372 |min| 379 |max| 385 - |mask| 391 |length| 396 |leftReducedSystem| 401 |lcm| 412 - |latex| 423 |invmod| 428 |init| 434 |inc| 438 |hash| 443 - |gcdPolynomial| 448 |gcd| 454 |factorial| 465 |factor| 470 - |extendedEuclidean| 475 |exquo| 488 |expressIdealMember| - 494 |even?| 500 |euclideanSize| 505 |divide| 510 - |differentiate| 516 |dec| 527 |copy| 532 |convert| 537 - |coerce| 567 |characteristic| 587 |bit?| 591 |binomial| - 597 |before?| 603 |base| 609 |associates?| 613 |addmod| - 619 |abs| 626 |Zero| 631 |One| 635 |OMwrite| 639 D 663 >= - 674 > 680 = 686 <= 692 < 698 - 704 + 715 ** 721 * 733) + (|Union| 137 '"failed") (|PositiveInteger|)) + '#(~= 163 |zero?| 169 |unitNormal| 174 |unitCanonical| 179 + |unit?| 184 |symmetricRemainder| 189 |subtractIfCan| 195 + |submod| 201 |squareFreePart| 208 |squareFree| 213 + |sizeLess?| 218 |sign| 224 |shift| 229 |sample| 235 + |retractIfCan| 239 |retract| 244 |rem| 249 |reducedSystem| + 255 |recip| 266 |rationalIfCan| 271 |rational?| 276 + |rational| 281 |random| 286 |quo| 295 |principalIdeal| 301 + |prime?| 306 |powmod| 311 |positiveRemainder| 318 + |positive?| 324 |permutation| 329 |patternMatch| 335 + |one?| 342 |odd?| 347 |nextItem| 352 |negative?| 357 + |multiEuclidean| 362 |mulmod| 368 |min| 375 |max| 381 + |mask| 387 |length| 392 |leftReducedSystem| 397 |lcm| 408 + |latex| 419 |invmod| 424 |init| 430 |inc| 434 |hash| 439 + |gcdPolynomial| 444 |gcd| 450 |factorial| 461 |factor| 466 + |extendedEuclidean| 471 |exquo| 484 |expressIdealMember| + 490 |even?| 496 |euclideanSize| 501 |divide| 506 + |differentiate| 512 |dec| 523 |copy| 528 |convert| 533 + |coerce| 563 |characteristic| 583 |bit?| 587 |binomial| + 593 |before?| 599 |base| 605 |associates?| 609 |addmod| + 615 |abs| 622 |Zero| 627 |One| 631 |OMwrite| 635 D 659 >= + 670 > 676 = 682 <= 688 < 694 - 700 + 711 ** 717 * 729) '((|infinite| . 0) (|noetherian| . 0) (|canonicalsClosed| . 0) (|canonical| . 0) (|canonicalUnitNormal| . 0) (|multiplicativeValuation| . 0) @@ -643,9 +642,9 @@ (|DifferentialRing|) (|OrderedRing|) (|CommutativeRing|) (|EntireRing|) (|Module| $$) - (|LinearlyExplicitRingOver| 17) + (|LinearlyExplicitRingOver| 14) (|BiModule| $$ $$) (|Ring|) - (|LeftModule| 17) + (|LeftModule| 14) (|OrderedAbelianGroup|) (|LeftModule| $$) (|Rng|) (|RightModule| $$) @@ -656,75 +655,75 @@ (|OrderedAbelianSemiGroup|) (|LinearSet| $$) (|AbelianMonoid|) (|Monoid|) (|StepThrough|) - (|PatternMatchable| 17) (|OrderedSet|) + (|PatternMatchable| 14) (|OrderedSet|) (|LeftLinearSet| $$) (|RightLinearSet| $$) (|AbelianSemiGroup|) (|SemiGroup|) - (|LeftLinearSet| 17) + (|LeftLinearSet| 14) (|DifferentialSpace|) (|OrderedType|) (|SetCategory|) (|RealConstant|) - (|RetractableTo| 17) + (|RetractableTo| 14) (|DifferentialDomain| $$) (|BasicType|) - (|OpenMath|) (|ConvertibleTo| 14) + (|OpenMath|) (|ConvertibleTo| 11) + (|ConvertibleTo| 52) (|ConvertibleTo| 55) - (|ConvertibleTo| 58) (|CombinatorialFunctionCategory|) - (|ConvertibleTo| 131) - (|ConvertibleTo| 61) - (|ConvertibleTo| 17) + (|ConvertibleTo| 130) + (|ConvertibleTo| 58) + (|ConvertibleTo| 14) (|CoercibleFrom| $$) - (|CoercibleFrom| 17) (|Type|) - (|CoercibleTo| 44)) - (|makeByteWordVec2| 140 - '(0 7 0 8 1 12 11 0 13 3 12 11 0 14 14 - 15 2 12 11 0 17 18 1 12 11 0 19 0 20 - 0 21 2 12 0 14 20 22 1 12 11 0 23 1 - 12 11 0 24 1 12 11 0 25 0 7 0 32 1 44 - 0 17 45 1 55 0 17 56 1 58 0 17 59 1 - 61 0 17 62 1 14 0 17 64 2 17 9 0 0 66 - 2 14 0 0 0 67 2 101 100 99 98 102 1 - 105 104 103 106 1 103 0 0 107 1 103 2 - 0 108 1 109 104 103 110 1 103 0 2 111 - 2 0 92 0 0 112 1 0 113 0 114 2 117 - 104 115 116 118 2 119 104 104 104 120 - 1 109 104 103 121 1 103 9 0 122 1 103 - 0 0 123 1 125 103 124 126 2 0 9 0 0 1 - 1 0 9 0 30 1 0 95 0 96 1 0 0 0 97 1 0 - 9 0 1 2 0 0 0 0 1 2 0 92 0 0 1 3 0 0 - 0 0 0 52 1 0 0 0 1 1 0 113 0 1 2 0 9 - 0 0 1 1 0 17 0 1 2 0 0 0 0 91 0 0 0 1 - 1 0 133 0 1 1 0 17 0 1 2 0 0 0 0 53 1 - 0 70 71 72 2 0 74 71 75 76 1 0 92 0 - 93 1 0 130 0 1 1 0 9 0 1 1 0 129 0 1 - 0 0 0 78 1 0 0 0 79 2 0 0 0 0 90 1 0 - 135 134 1 1 0 9 0 1 3 0 0 0 0 0 1 2 0 - 0 0 0 69 1 0 9 0 1 2 0 0 0 0 1 3 0 - 132 0 131 132 1 1 0 9 0 34 1 0 9 0 85 - 1 0 92 0 1 1 0 9 0 43 2 0 136 134 0 1 - 3 0 0 0 0 0 54 2 0 0 0 0 87 2 0 0 0 0 - 86 1 0 0 0 1 1 0 0 0 49 2 0 74 75 0 1 - 1 0 70 75 1 2 0 0 0 0 1 1 0 0 134 1 1 - 0 14 0 68 2 0 0 0 0 1 0 0 0 1 1 0 0 0 - 38 1 0 41 0 42 2 0 127 127 127 128 2 - 0 0 0 0 94 1 0 0 134 1 1 0 0 0 1 1 0 - 113 0 114 2 0 137 0 0 1 3 0 139 0 0 0 - 1 2 0 92 0 0 112 2 0 136 134 0 1 1 0 - 9 0 1 1 0 7 0 1 2 0 88 0 0 89 2 0 0 0 - 7 1 1 0 0 0 1 1 0 0 0 40 1 0 0 0 36 1 - 0 14 0 65 1 0 58 0 60 1 0 55 0 57 1 0 - 131 0 1 1 0 61 0 63 1 0 17 0 48 1 0 0 - 17 47 1 0 0 0 1 1 0 0 17 47 1 0 44 0 - 46 0 0 7 1 2 0 9 0 0 1 2 0 0 0 0 1 2 - 0 9 0 0 1 0 0 0 35 2 0 9 0 0 1 3 0 0 - 0 0 0 51 1 0 0 0 77 0 0 0 6 0 0 0 31 - 3 0 11 12 0 9 29 2 0 14 0 9 27 2 0 11 - 12 0 28 1 0 14 0 26 2 0 0 0 7 1 1 0 0 - 0 1 2 0 9 0 0 50 2 0 9 0 0 80 2 0 9 0 - 0 33 2 0 9 0 0 81 2 0 9 0 0 10 1 0 0 - 0 16 2 0 0 0 0 39 2 0 0 0 0 37 2 0 0 - 0 7 84 2 0 0 0 140 1 2 0 0 17 0 83 2 - 0 0 0 0 82 2 0 0 17 0 83 2 0 0 7 0 1 - 2 0 0 140 0 1))))) + (|CoercibleFrom| 14) (|Type|) + (|CoercibleTo| 41)) + (|makeByteWordVec2| 139 + '(1 9 8 0 10 3 9 8 0 11 11 12 2 9 8 0 + 14 15 1 9 8 0 16 0 17 0 18 2 9 0 11 + 17 19 1 9 8 0 20 1 9 8 0 21 1 9 8 0 + 22 1 41 0 14 42 1 52 0 14 53 1 55 0 + 14 56 1 58 0 14 59 1 11 0 14 61 0 63 + 0 64 2 14 6 0 0 65 2 11 0 0 0 66 2 + 100 99 98 97 101 1 104 103 102 105 1 + 102 0 0 106 1 102 2 0 107 1 108 103 + 102 109 1 102 0 2 110 2 0 91 0 0 111 + 1 0 112 0 113 2 116 103 114 115 117 2 + 118 103 103 103 119 1 108 103 102 120 + 1 102 6 0 121 1 102 0 0 122 1 124 102 + 123 125 2 0 6 0 0 1 1 0 6 0 29 1 0 94 + 0 95 1 0 0 0 96 1 0 6 0 1 2 0 0 0 0 1 + 2 0 91 0 0 1 3 0 0 0 0 0 49 1 0 0 0 1 + 1 0 112 0 1 2 0 6 0 0 1 1 0 14 0 1 2 + 0 0 0 0 90 0 0 0 1 1 0 132 0 1 1 0 14 + 0 1 2 0 0 0 0 50 1 0 69 70 71 2 0 73 + 70 74 75 1 0 91 0 92 1 0 129 0 1 1 0 + 6 0 1 1 0 128 0 1 0 0 0 77 1 0 0 0 78 + 2 0 0 0 0 89 1 0 134 133 1 1 0 6 0 1 + 3 0 0 0 0 0 1 2 0 0 0 0 68 1 0 6 0 1 + 2 0 0 0 0 1 3 0 131 0 130 131 1 1 0 6 + 0 31 1 0 6 0 84 1 0 91 0 1 1 0 6 0 7 + 2 0 135 133 0 1 3 0 0 0 0 0 51 2 0 0 + 0 0 86 2 0 0 0 0 85 1 0 0 0 1 1 0 0 0 + 46 2 0 73 74 0 1 1 0 69 74 1 2 0 0 0 + 0 1 1 0 0 133 1 1 0 11 0 67 2 0 0 0 0 + 1 0 0 0 1 1 0 0 0 35 1 0 38 0 39 2 0 + 126 126 126 127 2 0 0 0 0 93 1 0 0 + 133 1 1 0 0 0 1 1 0 112 0 113 2 0 136 + 0 0 1 3 0 138 0 0 0 1 2 0 91 0 0 111 + 2 0 135 133 0 1 1 0 6 0 1 1 0 63 0 1 + 2 0 87 0 0 88 2 0 0 0 63 1 1 0 0 0 1 + 1 0 0 0 37 1 0 0 0 33 1 0 11 0 62 1 0 + 55 0 57 1 0 52 0 54 1 0 130 0 1 1 0 + 58 0 60 1 0 14 0 45 1 0 0 14 44 1 0 0 + 0 1 1 0 0 14 44 1 0 41 0 43 0 0 63 1 + 2 0 6 0 0 1 2 0 0 0 0 1 2 0 6 0 0 1 0 + 0 0 32 2 0 6 0 0 1 3 0 0 0 0 0 48 1 0 + 0 0 76 0 0 0 27 0 0 0 30 3 0 8 9 0 6 + 26 2 0 11 0 6 24 2 0 8 9 0 25 1 0 11 + 0 23 2 0 0 0 63 1 1 0 0 0 1 2 0 6 0 0 + 47 2 0 6 0 0 79 2 0 6 0 0 28 2 0 6 0 + 0 80 2 0 6 0 0 40 1 0 0 0 13 2 0 0 0 + 0 36 2 0 0 0 0 34 2 0 0 0 63 83 2 0 0 + 0 139 1 2 0 0 14 0 82 2 0 0 0 0 81 2 + 0 0 14 0 82 2 0 0 63 0 1 2 0 0 139 0 + 1))))) '|lookupComplete|)) (MAKEPROP '|Integer| 'NILADIC T) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp index 2c120ff9..3aaf5260 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -715,11 +715,11 @@ (MAKEPROP '|IndexedString| '|infovec| (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|NonNegativeInteger|) (|Character|) |ISTRING;new;NniC$;1| - |ISTRING;empty;$;2| (|Integer|) (0 . |Zero|) (|Boolean|) + (|Integer|) (0 . |Zero|) |ISTRING;empty;$;2| (|Boolean|) (4 . =) |ISTRING;empty?;$B;3| |ISTRING;#;$Nni;4| |ISTRING;=;2$B;5| |ISTRING;<;2$B;6| |ISTRING;concat;3$;7| |ISTRING;copy;2$;8| (10 . |One|) (14 . -) - (|UniversalSegment| 11) (20 . SEGMENT) + (|UniversalSegment| 10) (20 . SEGMENT) |ISTRING;elt;$Us$;31| (26 . SEGMENT) |ISTRING;insert;2$I$;9| (|String|) (|OutputForm|) (31 . |outputForm|) |ISTRING;coerce;$Of;10| @@ -748,7 +748,7 @@ |ISTRING;match?;2$CB;34| (|List| 8) (|Equation| 8) (|List| 91) (|Mapping| 8 8 8) (|InputForm|) (|Mapping| 13 8) (|Mapping| 13 8 8) (|Void|) - (|Union| 8 '"failed") (|List| 11)) + (|Union| 8 '"failed") (|List| 10)) '#(~= 185 |upperCase!| 191 |upperCase| 196 |trim| 201 |swap!| 213 |suffix?| 220 |substring?| 226 |split| 233 |sorted?| 245 |sort!| 256 |sort| 267 |size?| 278 |setelt| 284 @@ -783,61 +783,61 @@ (|OneDimensionalArrayAggregate| 8) (|FiniteLinearAggregate| 8) (|LinearAggregate| 8) - (|IndexedAggregate| 11 8) + (|IndexedAggregate| 10 8) (|Collection| 8) (|HomogeneousAggregate| 8) - (|OrderedSet|) (|EltableAggregate| 11 8) + (|OrderedSet|) (|EltableAggregate| 10 8) (|SetCategory|) (|OrderedType|) (|Eltable| 23 $$) (|Aggregate|) - (|Eltable| 11 8) (|Evalable| 8) + (|Eltable| 10 8) (|Evalable| 8) (|BasicType|) (|Type|) (|InnerEvalable| 8 8) (|CoercibleTo| 29) (|ConvertibleTo| 94)) (|makeByteWordVec2| 99 - '(0 11 0 12 2 11 13 0 0 14 0 11 0 21 2 - 11 0 0 0 22 2 23 0 11 11 24 1 23 0 11 + '(0 10 0 11 2 10 13 0 0 14 0 10 0 21 2 + 10 0 0 0 22 2 23 0 10 10 24 1 23 0 10 26 1 29 0 28 30 0 33 0 34 1 8 0 0 35 2 0 0 36 0 37 0 33 0 39 1 8 0 0 40 2 - 28 0 0 0 42 1 23 11 0 44 1 23 13 0 45 - 1 23 11 0 46 1 0 11 0 47 0 7 0 48 2 - 11 13 0 0 49 2 11 13 0 0 50 0 7 0 51 - 2 11 0 0 0 52 0 8 0 53 0 54 0 55 2 7 - 0 0 0 56 2 11 13 0 0 58 0 13 0 60 0 + 28 0 0 0 42 1 23 10 0 44 1 23 13 0 45 + 1 23 10 0 46 1 0 10 0 47 0 7 0 48 2 + 10 13 0 0 49 2 10 13 0 0 50 0 7 0 51 + 2 10 0 0 0 52 0 8 0 53 0 54 0 55 2 7 + 0 0 0 56 2 10 13 0 0 58 0 13 0 60 0 13 0 61 2 33 13 8 0 65 2 8 13 0 0 69 0 70 0 71 2 70 0 2 0 72 1 70 0 0 73 2 - 11 0 0 0 83 2 11 13 0 0 87 2 0 13 0 0 + 10 0 0 0 83 2 10 13 0 0 87 2 0 13 0 0 88 2 10 13 0 0 1 1 0 0 0 38 1 0 0 0 1 - 2 0 0 0 8 1 2 0 0 0 33 1 3 0 97 0 11 - 11 1 2 0 13 0 0 67 3 0 13 0 0 11 62 2 + 2 0 0 0 8 1 2 0 0 0 33 1 3 0 97 0 10 + 10 1 2 0 13 0 0 67 3 0 13 0 0 10 62 2 0 74 0 33 76 2 0 74 0 8 75 1 5 13 0 1 2 0 13 96 0 1 1 5 0 0 1 2 0 0 96 0 1 1 5 0 0 1 2 0 0 96 0 1 2 0 13 0 7 1 3 - 0 8 0 23 8 1 3 0 8 0 11 8 59 2 0 0 95 + 0 8 0 23 8 1 3 0 8 0 10 8 59 2 0 0 95 0 1 0 0 0 1 2 0 0 0 8 79 2 0 0 0 33 80 1 0 0 0 1 1 0 0 0 1 3 0 0 0 23 0 57 1 8 0 0 1 2 8 0 8 0 1 2 0 0 95 0 1 4 8 8 93 0 8 8 1 3 0 8 93 0 8 1 2 0 8 - 93 0 1 3 0 8 0 11 8 1 2 0 8 0 11 1 2 - 0 13 0 0 88 3 8 11 8 0 11 64 2 8 11 8 - 0 1 3 0 11 33 0 11 66 3 0 11 0 0 11 - 63 2 0 11 95 0 1 1 0 90 0 1 2 0 0 7 8 - 9 2 0 13 0 7 1 1 7 11 0 32 2 5 0 0 0 + 93 0 1 3 0 8 0 10 8 1 2 0 8 0 10 1 2 + 0 13 0 0 88 3 8 10 8 0 10 64 2 8 10 8 + 0 1 3 0 10 33 0 10 66 3 0 10 0 0 10 + 63 2 0 10 95 0 1 1 0 90 0 1 2 0 0 7 8 + 9 2 0 13 0 7 1 1 7 10 0 32 2 5 0 0 0 1 2 5 0 0 0 1 3 0 0 96 0 0 1 1 0 90 0 - 1 2 8 13 8 0 1 1 7 11 0 47 2 5 0 0 0 + 1 2 8 13 8 0 1 1 7 10 0 47 2 5 0 0 0 1 3 0 13 0 0 8 89 3 0 7 0 0 8 86 2 0 0 36 0 37 3 0 0 93 0 0 1 2 0 0 36 0 1 1 0 0 0 41 1 0 0 0 1 2 0 13 0 7 1 2 0 0 0 8 77 2 0 0 0 33 78 1 8 28 0 43 3 - 0 0 8 0 11 1 3 0 0 0 0 11 27 1 0 99 0 - 1 2 0 13 11 0 1 1 8 84 0 85 1 7 8 0 1 + 0 0 8 0 10 1 3 0 0 0 0 10 27 1 0 99 0 + 1 2 0 13 10 0 1 1 8 84 0 85 1 7 8 0 1 2 0 98 95 0 1 2 0 0 0 8 1 2 0 13 95 0 1 3 11 0 0 90 90 1 3 11 0 0 8 8 1 2 11 0 0 92 1 2 11 0 0 91 1 2 0 13 0 0 1 2 8 13 8 0 1 1 0 90 0 1 1 0 13 0 15 - 0 0 0 10 2 0 0 0 0 1 2 0 0 0 23 25 2 - 0 8 0 11 68 3 0 8 0 11 8 1 2 0 0 0 11 + 0 0 0 12 2 0 0 0 0 1 2 0 0 0 23 25 2 + 0 8 0 10 68 3 0 8 0 10 8 1 2 0 0 0 10 1 2 0 0 0 23 1 2 8 7 8 0 1 2 0 7 95 0 - 1 3 0 0 0 0 11 81 1 0 0 0 20 1 3 94 0 + 1 3 0 0 0 0 10 81 1 0 0 0 20 1 3 94 0 1 1 0 0 90 1 2 0 0 0 0 19 1 0 0 74 82 2 0 0 8 0 1 2 0 0 0 8 1 1 9 29 0 31 1 0 0 8 1 2 10 13 0 0 1 2 0 13 95 0 1 2 diff --git a/src/algebra/string.spad.pamphlet b/src/algebra/string.spad.pamphlet index 2469249d..9f2e5883 100644 --- a/src/algebra/string.spad.pamphlet +++ b/src/algebra/string.spad.pamphlet @@ -82,6 +82,7 @@ Character: OrderedFinite() with import %cge: (%,%) -> Boolean from Foreign Builtin import %c2i: % -> NNI from Foreign Builtin import %i2c: NNI -> % from Foreign Builtin + import %ccst: String -> % from Foreign Builtin a = b == %ceq(a,b) a < b == %clt(a,b) @@ -94,9 +95,9 @@ Character: OrderedFinite() with char(n: NNI) == %i2c n ord c == %c2i c random() == char(random(size())$NNI) - space == CHAR(" ", 0$Lisp)$Lisp - quote == CHAR("_" ", 0$Lisp)$Lisp - escape == CHAR("__ ", 0$Lisp)$Lisp + space == %ccst " " + quote == %ccst "_"" + escape == %ccst "__" coerce(c:%):OutputForm == c : OutputForm digit? c == member?(c, digit()) hexDigit? c == member?(c, hexDigit()) @@ -272,7 +273,7 @@ IndexedString(mn:Integer): Export == Implementation where -- new n == MAKE_-FULL_-CVEC(n, space$C)$Lisp new(n, c) == MAKE_-FULL_-CVEC(n, c)$Lisp - empty() == MAKE_-FULL_-CVEC(0$Lisp)$Lisp + empty() == MAKE_-FULL_-CVEC(0@I)$Lisp empty?(s) == Qsize(s) = 0 #s == Qsize(s) s = t == Qequal(s, t) diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 2a2f5a60..c7121f01 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -439,17 +439,17 @@ $VMsideEffectFreeOperators == SPADfirst QVELT _+ _- _* _< _= _<_= _> _>_= ASH INTEGER_-LENGTH QEQCAR QCDR QCAR IDENTP SYMBOLP GREATERP ZEROP ODDP FLOAT_-RADIX FLOAT FLOAT_-SIGN - CGREATERP GGREATERP CHAR GET BVEC_-GREATER %false %true + CGREATERP GGREATERP CHAR GET BVEC_-GREATER %when %false %true %and %or %not %peq %ieq %ilt %ile %igt %ige %head %tail %integer? - %beq %blt %ble %bgt %bge %bitand %bitior %bitnot %bcompl - %icst0 %icst1 - %imul %iadd %isub %igcd %ilcm %ipow %imin %imax %ieven? %iodd? %iinc - %feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax %float? - %fpow %fdiv %fneg %i2f %fminval %fmaxval %fbase %fprec %ftrunc - %nil %pair? %lconcat %llength %lfirst %lsecond %lthird - %lreverse %lempty? %hash %ismall? %string? %f2s - %ceq %clt %cle %cgt %cge %c2i %i2c %sname - %vref %vlength %before?) + %beq %blt %ble %bgt %bge %bitand %bitior %bitnot %bcompl + %icst0 %icst1 + %imul %iadd %isub %igcd %ilcm %ipow %imin %imax %ieven? %iodd? %iinc + %feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax %float? + %fpow %fdiv %fneg %i2f %fminval %fmaxval %fbase %fprec %ftrunc + %nil %pair? %lconcat %llength %lfirst %lsecond %lthird + %lreverse %lempty? %hash %ismall? %string? %f2s + %ccst %ceq %clt %cle %cgt %cge %c2i %i2c %sname + %vref %vlength %before?) ++ List of simple VM operators $simpleVMoperators == diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 9817e8e4..c1cc9217 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -251,6 +251,12 @@ expandBcompl ['%bcompl,x] == integer? x => 255 - x ['_+,256,['LOGNOT,expandToVMForm x]] +-- Character operations +expandCcst ['%ccst,s] == + not string? s => error "operand is not a string constant" + #s ~= 1 => error "string constant must contain exactly one character" + char s + -- Integer operations expandIneg ['%ineg,x] == x := expandToVMForm x @@ -449,6 +455,8 @@ for x in [ ['%bcompl, :function expandBcompl], + ['%ccst, :function expandCcst], + ['%ieq, :function expandIeq], ['%igt, :function expandIgt], ['%ilt, :function expandIlt], -- cgit v1.2.3