diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 27 | ||||
| -rw-r--r-- | src/algebra/d01routine.spad.pamphlet | 6 | ||||
| -rw-r--r-- | src/algebra/d01transform.spad.pamphlet | 2 | ||||
| -rw-r--r-- | src/algebra/forttyp.spad.pamphlet | 1 | ||||
| -rw-r--r-- | src/algebra/mts.spad.pamphlet | 84 | ||||
| -rw-r--r-- | src/algebra/multsqfr.spad.pamphlet | 5 | ||||
| -rw-r--r-- | src/algebra/naalgc.spad.pamphlet | 4 | ||||
| -rw-r--r-- | src/algebra/newpoly.spad.pamphlet | 22 | ||||
| -rw-r--r-- | src/algebra/permgrps.spad.pamphlet | 1 | ||||
| -rw-r--r-- | src/algebra/pfo.spad.pamphlet | 7 | ||||
| -rw-r--r-- | src/interp/nlib.lisp | 22 |
11 files changed, 96 insertions, 85 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index a4de5bf5..cf8babc3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,30 @@ +2010-06-21 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/nlib.lisp (COMPILE-LIB-FILE): Rework. Halt compilation + if generated is malformed or contains serious warnings. + * algebra/pfo.spad.pamphlet (PointsOfFiniteOrder) [cmult]: Merge + local conditional definitions. + * algebra/permgrps.spad.pamphlet (PermutationGroup) [cosetRep]: + Don't forget to return a value. + * algebra/newpoly.spad.pamphlet (RecursivePolynomialCategory) + [exactQuo]: Merge conditional local definitions. + [ZToR]: Inline at sole use point. Remove conditional definitions. + [QToR]: Likewise. + [PZToPR]: Likewise. + [PQToPR]: Likewise. + * algebra/naalgc.spad.pamphlet (FramedNonAssociativeAlgebra) + [leftRankPolynomial]: Initialize local variable xx. + (rightRankPolynomial): Likewise. + * algebra/multsqfr.spad.pamphlet (MultivariateSquareFree) + [intChoose]: Error if no solution is found in the loop. + * algebra/mts.spad.pamphlet (SparseMultivariateTaylorSeries): Tidy. + [stream] Remove duplicate definition. + * algebra/d01routine.spad.pamphlet (d01anfAnnaType) [measure]: Tidy. + (d01asfAnnaType) [measure]: Likewise. + * algebra/d01transform.spad.pamphlet (d01TransformFunctionType) + [measure]: Likewise. + * algebra/forttyp.spad.pamphlet (FortranScalarType) [coerce]: Likewise. + 2010-06-20 Gabriel Dos Reis <gdr@cs.tamu.edu> * algebra/sgcf.spad.pamphlet (SymmetricGroupCombinatoricFunctions) diff --git a/src/algebra/d01routine.spad.pamphlet b/src/algebra/d01routine.spad.pamphlet index ee7b45fa..66dbccf8 100644 --- a/src/algebra/d01routine.spad.pamphlet +++ b/src/algebra/d01routine.spad.pamphlet @@ -456,8 +456,6 @@ d01anfAnnaType(): NumericalIntegrationCategory == Result add ext:Result := empty()$Result weight:Union(Record(op:BOP,w:DF),"failed") := exprHasWeightCosWXorSinWX(args) - weight case "failed" => - [0.0,"d01anf: A suitable weight has not been found", ext] weight case Record(op:BOP,w:DF) => wany := coerce(weight)$AnyFunctions1(Record(op:BOP,w:DF)) ex:Record(key:S,entry:Any) := [d01anfextra@S,wany] @@ -466,6 +464,7 @@ d01anfAnnaType(): NumericalIntegrationCategory == Result add string(args.var)$S ")" [getMeasure(R,d01anf@S)$RT, "d01anf: The expression has a suitable weight:- " ws, ext] + [0.0,"d01anf: A suitable weight has not been found", ext] numericalIntegration(args:NIA,hints:Result) == a:INT @@ -529,8 +528,6 @@ d01asfAnnaType(): NumericalIntegrationCategory == Result add [0.0,"d01asf is not a suitable routine for infinite integrals",ext] weight: Union(Record(op:BOP,w:DF),"failed") := exprHasWeightCosWXorSinWX(args) - weight case "failed" => - [0.0,"d01asf: A suitable weight has not been found", ext] weight case Record(op:BOP,w:DF) => wany := coerce(weight)$AnyFunctions1(Record(op:BOP,w:DF)) ex:Record(key:S,entry:Any) := [d01asfextra@S,wany] @@ -539,6 +536,7 @@ d01asfAnnaType(): NumericalIntegrationCategory == Result add string(args.var)$S ")" [getMeasure(R,d01asf@S)$RT, "d01asf: A suitable weight has been found:- " ws, ext] + [0.0,"d01asf: A suitable weight has not been found", ext] numericalIntegration(args:NIA,hints:Result) == i:INT diff --git a/src/algebra/d01transform.spad.pamphlet b/src/algebra/d01transform.spad.pamphlet index f1949db4..29cd588f 100644 --- a/src/algebra/d01transform.spad.pamphlet +++ b/src/algebra/d01transform.spad.pamphlet @@ -127,7 +127,6 @@ d01TransformFunctionType():NumericalIntegrationCategory == Result add measure(R:RoutinesTable,args:NIA) == Range:=rangeIsFinite(args) - Range case bothInfinite => split(1,args) Range case upperInfinite => positive?(lo(args.range))$OCDF => transform(true,args) @@ -136,6 +135,7 @@ d01TransformFunctionType():NumericalIntegrationCategory == Result add negative?(hi(args.range))$OCDF => transform(false,args) split(3,args) + split(1,args) numericalIntegration(args:NIA,hints:Result) == mainResult:DF := mainAbserr:DF := 0$DF diff --git a/src/algebra/forttyp.spad.pamphlet b/src/algebra/forttyp.spad.pamphlet index c1800ccd..77e05eed 100644 --- a/src/algebra/forttyp.spad.pamphlet +++ b/src/algebra/forttyp.spad.pamphlet @@ -130,6 +130,7 @@ FortranScalarType() : exports == implementation where s = upperDoubleSymbol => ["double precision"]$Rep s = doubleComplexSymbol => ["double complex"]$Rep s = upperDoubleCOmplexSymbol => ["double complex"]$Rep + error concat([string s," is invalid as a Fortran Type"])$String coerce(s:String):$ == s = "real" => ["real"]$Rep diff --git a/src/algebra/mts.spad.pamphlet b/src/algebra/mts.spad.pamphlet index 1f232c31..14037a2a 100644 --- a/src/algebra/mts.spad.pamphlet +++ b/src/algebra/mts.spad.pamphlet @@ -77,6 +77,9 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ Implementation ==> PS add Rep := StS -- Below we use the fact that Rep of PS is Stream SMP. + -- FIXME: The next two functions come free if assignment to Rep is removed. + rep(x: %): Rep == x pretend Rep + per(x: Rep): % == x pretend % extend(x,n) == extend(x,n + 1)$Rep complete x == complete(x)$Rep @@ -95,9 +98,9 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ --% creation of series coerce(r:Coef) == monom(r::SMP,0)$STT - smp:SMP * p:% == (((smp) * (p pretend Rep))$STT)pretend % - r:Coef * p:% == (((r::SMP) * (p pretend Rep))$STT)pretend % - p:% * r:Coef == (((r::SMP) * ( p pretend Rep))$STT)pretend % + smp:SMP * p:% == per((smp * rep p)$STT) + r:Coef * p:% == per(((r::SMP) * rep p )$STT) + p:% * r:Coef == per(((r::SMP) * rep p)$STT) mts(p:SMP):% == (uv := mainVariable p) case "failed" => monom(p,0)$STT v := uv :: Var @@ -187,43 +190,40 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ map(differentiate(#1,v),rst s) if Coef has Algebra Fraction Integer then - - stream(x:%):Rep == x pretend Rep - - (x:%) ** (r:RN) == powern(r,stream x)$STT - (r:RN) * (x:%) == map(r * #1, stream x)$ST2(SMP,SMP) pretend % - (x:%) * (r:RN) == map(#1 * r,stream x )$ST2(SMP,SMP) pretend % - - exp x == exp(stream x)$STF - log x == log(stream x)$STF - - sin x == sin(stream x)$STF - cos x == cos(stream x)$STF - tan x == tan(stream x)$STF - cot x == cot(stream x)$STF - sec x == sec(stream x)$STF - csc x == csc(stream x)$STF - - asin x == asin(stream x)$STF - acos x == acos(stream x)$STF - atan x == atan(stream x)$STF - acot x == acot(stream x)$STF - asec x == asec(stream x)$STF - acsc x == acsc(stream x)$STF - - sinh x == sinh(stream x)$STF - cosh x == cosh(stream x)$STF - tanh x == tanh(stream x)$STF - coth x == coth(stream x)$STF - sech x == sech(stream x)$STF - csch x == csch(stream x)$STF - - asinh x == asinh(stream x)$STF - acosh x == acosh(stream x)$STF - atanh x == atanh(stream x)$STF - acoth x == acoth(stream x)$STF - asech x == asech(stream x)$STF - acsch x == acsch(stream x)$STF + (x:%) ** (r:RN) == powern(r,rep x)$STT + (r:RN) * (x:%) == per map(r * #1, rep x)$ST2(SMP,SMP) + (x:%) * (r:RN) == per map(#1 * r,rep x )$ST2(SMP,SMP) + + exp x == exp(rep x)$STF + log x == log(rep x)$STF + + sin x == sin(rep x)$STF + cos x == cos(rep x)$STF + tan x == tan(rep x)$STF + cot x == cot(rep x)$STF + sec x == sec(rep x)$STF + csc x == csc(rep x)$STF + + asin x == asin(rep x)$STF + acos x == acos(rep x)$STF + atan x == atan(rep x)$STF + acot x == acot(rep x)$STF + asec x == asec(rep x)$STF + acsc x == acsc(rep x)$STF + + sinh x == sinh(rep x)$STF + cosh x == cosh(rep x)$STF + tanh x == tanh(rep x)$STF + coth x == coth(rep x)$STF + sech x == sech(rep x)$STF + csch x == csch(rep x)$STF + + asinh x == asinh(rep x)$STF + acosh x == acosh(rep x)$STF + atanh x == atanh(rep x)$STF + acoth x == acoth(rep x)$STF + asech x == asech(rep x)$STF + acsch x == acsch(rep x)$STF intsmp(v:Var,p: SMP): SMP == up := univariate(p,v) @@ -272,9 +272,7 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ empty? l => (0$SMP) :: OUT reduce("+",reverse! l) if Coef has Field then - stream(x:%):Rep == x pretend Rep - SF2==> StreamFunctions2 - p:% / r:Coef ==(map(#1/$SMP r,stream p)$SF2(SMP,SMP))pretend % + p:% / r:Coef == per(map(#1/$SMP r,rep p)$StreamFunctions2(SMP,SMP)) @ \section{domain TS TaylorSeries} diff --git a/src/algebra/multsqfr.spad.pamphlet b/src/algebra/multsqfr.spad.pamphlet index be6949f3..b05b4bb9 100644 --- a/src/algebra/multsqfr.spad.pamphlet +++ b/src/algebra/multsqfr.spad.pamphlet @@ -235,7 +235,7 @@ MultivariateSquareFree (E,OV,R,P) : C == T where ctf1:R:=1 f1:BP:=1$BP d1:Z - while range<10000000000 repeat + while range < 10000000000 repeat range:=2*range lval:= [ran(range) for i in 1..nvr] member?(lval,ltry) => "new integer" @@ -267,7 +267,8 @@ MultivariateSquareFree (E,OV,R,P) : C == T where ctf1:=ctf lval1:=lval d1:=d0 - + error "intChoose$MULTQFR: fell off loop without value" + ---- Choose the leading coefficient for the lifting ---- coefChoose(exp:Z,sqlead:Factored(P)) : P == diff --git a/src/algebra/naalgc.spad.pamphlet b/src/algebra/naalgc.spad.pamphlet index b0d5b2d3..b68e779c 100644 --- a/src/algebra/naalgc.spad.pamphlet +++ b/src/algebra/naalgc.spad.pamphlet @@ -1022,7 +1022,7 @@ FramedNonAssociativeAlgebra(R:CommutativeRing): Category == _ listOfNumbers : List String := [STRINGIMAGE(q)$Lisp for q in 1..n] symbolsForCoef : Vector Symbol := [concat("%", concat("x", i))::Symbol for i in listOfNumbers] - xx : M P R + xx : M P R := new(1,n,0) mo : P R x : M P R := new(1,n,0) for i in 1..n repeat @@ -1055,7 +1055,7 @@ FramedNonAssociativeAlgebra(R:CommutativeRing): Category == _ listOfNumbers : List String := [STRINGIMAGE(q)$Lisp for q in 1..n] symbolsForCoef : Vector Symbol := [concat("%", concat("x", i))::Symbol for i in listOfNumbers] - xx : M P R + xx : M P R := new(1,n,0) mo : P R x : M P R := new(1,n,0) for i in 1..n repeat diff --git a/src/algebra/newpoly.spad.pamphlet b/src/algebra/newpoly.spad.pamphlet index 23cd07b7..573a085f 100644 --- a/src/algebra/newpoly.spad.pamphlet +++ b/src/algebra/newpoly.spad.pamphlet @@ -1029,13 +1029,9 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet): Ca if R has IntegralDomain then - if R has EuclideanDomain - then - exactQuo(r:R,s:R):R == - r quo$R s - else - exactQuo(r:R,s:R):R == - (r exquo$R s)::R + exactQuo(r:R,s:R):R == + R has EuclideanDomain => r quo$R s + (r exquo$R s)::R exactQuotient (p:$,r:R) == (p exquo$$ r)::$ @@ -1215,10 +1211,6 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet): Ca mpc2Z := MPolyCatFunctions2(Symbol,IES,IES,Z,R,PZ,PR) mpc2Q := MPolyCatFunctions2(Symbol,IES,IES,Q,R,PQ,PR) - ZToR (z:Z):R == coerce(z)@R - QToR (q:Q):R == coerce(q)@R - PZToPR (pz:PZ):PR == map(ZToR,pz)$mpc2Z - PQToPR (pq:PQ):PR == map(QToR,pq)$mpc2Q retract(pz:PZ) == rif : Union($,"failed") := retractIfCan(pz)@Union($,"failed") @@ -1250,11 +1242,11 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet): Ca localRetractIfCanPQ(pq)@Union($,"failed") else retractIfCan(pq:PQ) == - pr : PR := PQToPR(pq) + pr : PR := map(#1::R,pq)$mpc2Q retractIfCan(pr)@Union($,"failed") retractIfCan(pz:PZ) == - pr : PR := PZToPR(pz) + pr : PR := map(#1::R,pz)$mpc2Z retractIfCan(pr)@Union($,"failed") retract(pr:PR) == @@ -1298,8 +1290,6 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet): Ca then mpc2Z := MPolyCatFunctions2(Symbol,IES,IES,Z,R,PZ,PR) - ZToR (z:Z):R == coerce(z)@R - PZToPR (pz:PZ):PR == map(ZToR,pz)$mpc2Z retract(pz:PZ) == rif : Union($,"failed") := retractIfCan(pz)@Union($,"failed") @@ -1323,7 +1313,7 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet): Ca localRetractIfCanPZ(pz)@Union($,"failed") else retractIfCan(pz:PZ) == - pr : PR := PZToPR(pz) + pr : PR := map(#1::R,pz)$mpc2Z retractIfCan(pr)@Union($,"failed") retract(pr:PR) == diff --git a/src/algebra/permgrps.spad.pamphlet b/src/algebra/permgrps.spad.pamphlet index 98e2ab75..7e88ad08 100644 --- a/src/algebra/permgrps.spad.pamphlet +++ b/src/algebra/permgrps.spad.pamphlet @@ -338,6 +338,7 @@ PermutationGroup(S:SetCategory): public == private where xelt := times ( x , xelt ) if wordProblem then word := append ( wordlist.p , word ) ppt := x.ppt + [xelt,word] bsgs1 (group:L V NNI,number1:NNI,words:L L NNI,maxLoops:I,gp:%,diff:I)_ : NNI == diff --git a/src/algebra/pfo.spad.pamphlet b/src/algebra/pfo.spad.pamphlet index 45b6ac45..970c8c98 100644 --- a/src/algebra/pfo.spad.pamphlet +++ b/src/algebra/pfo.spad.pamphlet @@ -385,10 +385,9 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where map(UP22UP(#1,k)::QF, p)$UnivariatePolynomialCategoryFunctions2(UP2, UP3, QF, UPUP) - if R0 has GcdDomain then - cmult(l:List SMP):SMP == lcm l - else - cmult(l:List SMP):SMP == */l + cmult(l:List SMP):SMP == + R0 has GcdDomain => lcm l + */l doubleDisc(f:UP3):Z == d := discriminant f diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp index a81d840b..1f4f913e 100644 --- a/src/interp/nlib.lisp +++ b/src/interp/nlib.lisp @@ -243,19 +243,15 @@ (setf (get fname 'compiler::fixed-args) t))) nil) -#+:AKCL -(defun compile-lib-file (fn &rest opts) - (unwind-protect - (progn - (trace (compiler::fast-link-proclaimed-type-p - :exitcond nil - :entrycond (spad-fixed-arg (car system::arglist)))) - (trace (compiler::t1defun :exitcond nil - :entrycond (spad-fixed-arg (caar system::arglist)))) - (apply #'compile-file fn opts)) - (untrace compiler::fast-link-proclaimed-type-p compiler::t1defun))) -#-:GCL -(define-function 'compile-lib-file #'compile-file) +(defun compile-lib-file (file) + (multiple-value-bind (result warning-p failure-p) + (compile-file file) + (cond ((null result) + (|systemError| (list "Generated Lisp was malformed"))) + (failure-p + (|removeFile| (namestring result)) + (|systemError| (list "Compilation of generated Lisp failed")))) + result)) ;; (RDROPITEMS filearg keys) don't delete, used in files.spad (defun rdropitems (filearg keys &aux (ctable (|getIndexTable| filearg))) |