aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog27
-rw-r--r--src/algebra/d01routine.spad.pamphlet6
-rw-r--r--src/algebra/d01transform.spad.pamphlet2
-rw-r--r--src/algebra/forttyp.spad.pamphlet1
-rw-r--r--src/algebra/mts.spad.pamphlet84
-rw-r--r--src/algebra/multsqfr.spad.pamphlet5
-rw-r--r--src/algebra/naalgc.spad.pamphlet4
-rw-r--r--src/algebra/newpoly.spad.pamphlet22
-rw-r--r--src/algebra/permgrps.spad.pamphlet1
-rw-r--r--src/algebra/pfo.spad.pamphlet7
-rw-r--r--src/interp/nlib.lisp22
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)))