aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-01-02 10:09:37 +0000
committerdos-reis <gdr@axiomatics.org>2011-01-02 10:09:37 +0000
commit2b2ae9894f66dba65af62fb08b9d79b2aee2a2a8 (patch)
treea993fb841dbecc560c217651a8504f23ed526481
parentb9a4e3cd1880e977a827a98b1cb69175e7ad1e74 (diff)
downloadopen-axiom-2b2ae9894f66dba65af62fb08b9d79b2aee2a2a8.tar.gz
* interp/nrunfast.boot (evalSlotDomain): Expand to VM forms before
value argument evaluation. (lazyMatch): Check for %llength too. * interp/g-opt.boot ($VMsideEffectFreeOperators): Include %2bit and %2bool. * interp/g-util.boot: Expand them. * interp/define.boot (compJoin): Check for %llenght too. * algebra/boolean.spad.pamphlet: Tidy. * algebra/domain.spad.pamphlet: Likewise. * algebra/draw.spad.pamphlet: Likewise. * algebra/files.spad.pamphlet: Likewise. * algebra/list.spad.pamphlet: Likewise. * algebra/outform.spad.pamphlet: Likewise. * algebra/sex.spad.pamphlet: Likewise. * algebra/sf.spad.pamphlet: Likewise.
Diffstat
-rw-r--r--src/ChangeLog18
-rw-r--r--src/algebra/boolean.spad.pamphlet8
-rw-r--r--src/algebra/domain.spad.pamphlet17
-rw-r--r--src/algebra/draw.spad.pamphlet8
-rw-r--r--src/algebra/files.spad.pamphlet2
-rw-r--r--src/algebra/list.spad.pamphlet25
-rw-r--r--src/algebra/outform.spad.pamphlet2
-rw-r--r--src/algebra/sex.spad.pamphlet6
-rw-r--r--src/algebra/sf.spad.pamphlet3
-rw-r--r--src/algebra/strap/CLAGG-.lsp2
-rw-r--r--src/algebra/strap/DFLOAT.lsp14
-rw-r--r--src/algebra/strap/EUCDOM-.lsp2
-rw-r--r--src/algebra/strap/HOAGG-.lsp2
-rw-r--r--src/algebra/strap/ILIST.lsp12
-rw-r--r--src/algebra/strap/LIST.lsp6
-rw-r--r--src/algebra/strap/OUTFORM.lsp15
-rw-r--r--src/algebra/strap/POLYCAT-.lsp2
-rw-r--r--src/algebra/strap/SYMBOL.lsp12
-rw-r--r--src/algebra/strap/UFD-.lsp5
-rw-r--r--src/algebra/strap/URAGG-.lsp2
-rw-r--r--src/boot/strap/tokens.clisp2
-rw-r--r--src/interp/define.boot4
-rw-r--r--src/interp/g-opt.boot3
-rw-r--r--src/interp/g-util.boot14
-rw-r--r--src/interp/nrunfast.boot18
25 files changed, 125 insertions, 79 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index e69de29b..6d9c399b 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -0,0 +1,18 @@
+2011-01-02 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/nrunfast.boot (evalSlotDomain): Expand to VM forms before
+ value argument evaluation.
+ (lazyMatch): Check for %llength too.
+ * interp/g-opt.boot ($VMsideEffectFreeOperators): Include %2bit
+ and %2bool.
+ * interp/g-util.boot: Expand them.
+ * interp/define.boot (compJoin): Check for %llenght too.
+ * algebra/boolean.spad.pamphlet: Tidy.
+ * algebra/domain.spad.pamphlet: Likewise.
+ * algebra/draw.spad.pamphlet: Likewise.
+ * algebra/files.spad.pamphlet: Likewise.
+ * algebra/list.spad.pamphlet: Likewise.
+ * algebra/outform.spad.pamphlet: Likewise.
+ * algebra/sex.spad.pamphlet: Likewise.
+ * algebra/sf.spad.pamphlet: Likewise.
+
diff --git a/src/algebra/boolean.spad.pamphlet b/src/algebra/boolean.spad.pamphlet
index 8833724a..d2b7ffa5 100644
--- a/src/algebra/boolean.spad.pamphlet
+++ b/src/algebra/boolean.spad.pamphlet
@@ -564,7 +564,7 @@ IndexedBits(mn:Integer): BitAggregate() with
s.i := if v.j then t else f
s::OutputForm
- new(n, b) == BVEC_-MAKE_-FULL(n,TRUTH_-TO_-BIT(b)$Lisp)$Lisp
+ new(n, b) == BVEC_-MAKE_-FULL(n, %2bit(b)$Foreign(Builtin))$Lisp
empty() == BVEC_-MAKE_-FULL(0,0)$Lisp
copy v == BVEC_-COPY(v)$Lisp
#v == BVEC_-SIZE(v)$Lisp
@@ -574,10 +574,10 @@ IndexedBits(mn:Integer): BitAggregate() with
u or v == (#v=#u => BVEC_-OR(v, u)$Lisp; map("or", v,u))
xor(v,u) == (#v=#u => BVEC_-XOR(v,u)$Lisp; map("xor",v,u))
setelt(v:%, i:Integer, f:Boolean) ==
- BIT_-TO_-TRUTH(BVEC_-SETELT(v, range(v, i-mn),
- TRUTH_-TO_-BIT(f)$Lisp)$Lisp)$Lisp
+ %2bool(BVEC_-SETELT(v, range(v, i-mn),
+ %2bit(f)$Foreign(Builtin))$Lisp)$Foreign(Builtin)
elt(v:%, i:Integer) ==
- BIT_-TO_-TRUTH(BVEC_-ELT(v, range(v, i-mn))$Lisp)$Lisp
+ %2bool(BVEC_-ELT(v, range(v, i-mn))$Lisp)$Foreign(Builtin)
Not v == BVEC_-NOT(v)$Lisp
And(u, v) == (#v=#u => BVEC_-AND(v,u)$Lisp; map("and",v,u))
diff --git a/src/algebra/domain.spad.pamphlet b/src/algebra/domain.spad.pamphlet
index f61d568f..ee52d8a5 100644
--- a/src/algebra/domain.spad.pamphlet
+++ b/src/algebra/domain.spad.pamphlet
@@ -108,10 +108,10 @@ ConstructorCategory(): Category == OperatorCategory Identifier with
++ exported by instantiations of constructor \spad{c}.
++ The operators are partitioned into overload sets.
add
- kind x == getConstructorKind(x)$Lisp
- arity x == getConstructorArity(x)$Lisp
- dualSignature x == getDualSignatureFromDB(x)$Lisp
- operations x == getConstructorOperationsFromDB(x)$Lisp
+ kind x == getConstructorKind(x)$Foreign(Builtin)
+ arity x == getConstructorArity(x)$Foreign(Builtin)
+ dualSignature x == getDualSignatureFromDB(x)$Foreign(Builtin)
+ operations x == getConstructorOperationsFromDB(x)$Foreign(Builtin)
@
@@ -133,10 +133,11 @@ Constructor(): ConstructorCategory with
== add
Rep == Identifier
name x == rep x
- kind x == getConstructorKind(x)$Lisp
- arity x == getConstructorArity(x)$Lisp
+ kind x == getConstructorKind(x)$Foreign(Builtin)
+ arity x == getConstructorArity(x)$Foreign(Builtin)
findConstructor s ==
- isConstructorName(s)$Lisp => just per(s pretend Identifier)
+ isConstructorName(s)$Foreign(Builtin) =>
+ just per(s pretend Identifier)
nothing
@
@@ -177,7 +178,7 @@ ConstructorCall(C: ConstructorCategory): Public == Private where
EQUAL(x,y)$Lisp
coerce(x: %): OutputForm ==
- outputDomainConstructor(x)$Lisp
+ outputDomainConstructor(x)$Foreign(Builtin)
@
diff --git a/src/algebra/draw.spad.pamphlet b/src/algebra/draw.spad.pamphlet
index 89ca6a1d..ca2c76a7 100644
--- a/src/algebra/draw.spad.pamphlet
+++ b/src/algebra/draw.spad.pamphlet
@@ -318,9 +318,9 @@ TopLevelDrawFunctionsForCompiledFunctions():
myTrap1: (SF-> SF, SF) -> SF
myTrap1(ff:SF-> SF, f:SF):SF ==
s := trapNumericErrors(ff(f))$Lisp :: Union(SF, "failed")
- s case "failed" => quietDoubleNaN()$Lisp
+ s case "failed" => quietDoubleNaN()$Foreign(Builtin)
r:=s::SF
- r >max()$SF or r < min()$SF => quietDoubleNaN()$Lisp
+ r >max()$SF or r < min()$SF => quietDoubleNaN()$Foreign(Builtin)
r
makePt2: (SF,SF) -> Point SF
@@ -493,9 +493,9 @@ TopLevelDrawFunctionsForCompiledFunctions():
myTrap2: ((SF, SF) -> SF, SF, SF) -> SF
myTrap2(ff:(SF, SF) -> SF, u:SF, v:SF):SF ==
s := trapNumericErrors(ff(u, v))$Lisp :: Union(SF, "failed")
- s case "failed" => quietDoubleNaN()$Lisp
+ s case "failed" => quietDoubleNaN()$Foreign(Builtin)
r:SF := s::SF
- r >max()$SF or r < min()$SF => quietDoubleNaN()$Lisp
+ r >max()$SF or r < min()$SF => quietDoubleNaN()$Foreign(Builtin)
r
recolor(ptFunc,colFunc) ==
diff --git a/src/algebra/files.spad.pamphlet b/src/algebra/files.spad.pamphlet
index 82fac4e6..695db887 100644
--- a/src/algebra/files.spad.pamphlet
+++ b/src/algebra/files.spad.pamphlet
@@ -364,7 +364,7 @@ KeyedAccessFile(Entry): KAFcategory == KAFcapsule where
ks: List Symbol := RKEYIDS(f.fileName)$Lisp
null ks => error ["Attempt to read empty file", f]
ix := random()$Integer rem #ks
- k: String := PNAME(ks.ix)$Lisp
+ k: String := string(ks.ix)
[k, SPADRREAD(k, f.fileState)$Lisp]
write!(f, pr) ==
f.fileIOmode ~= "output" => error ["File not in write state",f]
diff --git a/src/algebra/list.spad.pamphlet b/src/algebra/list.spad.pamphlet
index 89d79936..c67f91c1 100644
--- a/src/algebra/list.spad.pamphlet
+++ b/src/algebra/list.spad.pamphlet
@@ -55,16 +55,17 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where
Exports ==> ListAggregate S
Implementation ==>
add
- import %nil: % from Foreign Builtin
- import %makepair: (S,%) -> % from Foreign Builtin
- import %peq: (%,%) -> Boolean from Foreign Builtin
- import %lempty?: % -> Boolean from Foreign Builtin
- import %head: % -> S from Foreign Builtin
- import %tail: % -> % from Foreign Builtin
- import %lreverse: % -> % from Foreign Builtin
- import %lreverse!: % -> % from Foreign Builtin
+ import %nil: % from Foreign Builtin
+ import %makepair: (S,%) -> % from Foreign Builtin
+ import %peq: (%,%) -> Boolean from Foreign Builtin
+ import %lempty?: % -> Boolean from Foreign Builtin
+ import %head: % -> S from Foreign Builtin
+ import %tail: % -> % from Foreign Builtin
+ import %lreverse: % -> % from Foreign Builtin
+ import %lreverse!: % -> % from Foreign Builtin
+ import %llength: % -> NonNegativeInteger from Foreign Builtin
- #x == LENGTH(x)$Lisp
+ #x == %llength x
concat(s:S,x:%) == %makepair(s,x)
eq?(x,y) == %peq(x,y)
first x == SPADfirst(x)$Lisp
@@ -87,8 +88,8 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where
%tail RPLACD(x,y)$Lisp
construct l == l pretend %
parts s == s pretend List S
- reverse! x == NREVERSE(x)$Lisp
- reverse x == REVERSE(x)$Lisp
+ reverse! x == %lreverse! x
+ reverse x == %lreverse x
minIndex x == mn
rest(x, n) ==
@@ -103,7 +104,7 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where
if i = cycleMax and cyclic? x then error "cyclic list"
y := %makepair(%head x,y)
x := %tail x
- (NREVERSE(y)$Lisp)@%
+ %lreverse! y
if S has CoercibleTo(OutputForm) then
coerce(x):OutputForm ==
diff --git a/src/algebra/outform.spad.pamphlet b/src/algebra/outform.spad.pamphlet
index ff48d5e9..9880f30e 100644
--- a/src/algebra/outform.spad.pamphlet
+++ b/src/algebra/outform.spad.pamphlet
@@ -485,7 +485,7 @@ OutputForm(): SetCategory with
-- bug in product, paren blankSeparate []
-- uniformize integrals, products, etc as plexes.
- cons ==> CONS$Lisp
+ cons ==> %makepair$Foreign(Builtin)
car ==> %head$Foreign(Builtin)
cdr ==> %tail$Foreign(Builtin)
diff --git a/src/algebra/sex.spad.pamphlet b/src/algebra/sex.spad.pamphlet
index 2beef473..006bfcba 100644
--- a/src/algebra/sex.spad.pamphlet
+++ b/src/algebra/sex.spad.pamphlet
@@ -100,6 +100,8 @@ SExpressionOf(Str, Sym, Int, Flt, Expr): Decl == Body where
import %peq: (%,%) -> Boolean from Foreign Builtin
import %head: % -> % from Foreign Builtin
import %tail: % -> % from Foreign Builtin
+ import %llength: % -> Integer from Foreign Builtin
+ import %nil: % from Foreign Builtin
Rep := Expr
@@ -121,7 +123,7 @@ SExpressionOf(Str, Sym, Int, Flt, Expr): Decl == Body where
b1 = b2 == EQUAL(b1,b2)$Lisp
eq(b1, b2) == %peq(b1,b2)
- null? b == NULL(b)$Lisp
+ null? b == %peq(b,%nil)
atom? b == ATOM(b)$Lisp
pair? b == %pair? b
@@ -147,7 +149,7 @@ SExpressionOf(Str, Sym, Int, Flt, Expr): Decl == Body where
car b == %head b
cdr b == %tail b
- # b == LENGTH(b)$Lisp
+ # b == %llength b
elt(b:%, i:Integer) == destruct(b).i
elt(b:%, li:List Integer) ==
for i in li repeat b := destruct(b).i
diff --git a/src/algebra/sf.spad.pamphlet b/src/algebra/sf.spad.pamphlet
index 1585af6a..745dc254 100644
--- a/src/algebra/sf.spad.pamphlet
+++ b/src/algebra/sf.spad.pamphlet
@@ -315,6 +315,7 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
import %fsech: % -> % from Foreign Builtin
import %fasinh: % -> % from Foreign Builtin
import %facsch: % -> % from Foreign Builtin
+ import %fcstpi: () -> % from Foreign Builtin
manexp: % -> MER
@@ -374,7 +375,7 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
1 == %i2f(1@Integer)
-- rational approximation to e accurate to 23 digits
exp1() == %i2f(534625820200) / %i2f(196677847971)
- pi() == PI$Lisp
+ pi() == %fcstpi()
coerce(x:%):OutputForm == outputForm x
convert(x:%):InputForm == convert(x pretend DoubleFloat)$InputForm
x < y == %flt(x,y)
diff --git a/src/algebra/strap/CLAGG-.lsp b/src/algebra/strap/CLAGG-.lsp
index 9acb3b8b..759df315 100644
--- a/src/algebra/strap/CLAGG-.lsp
+++ b/src/algebra/strap/CLAGG-.lsp
@@ -42,7 +42,7 @@
|CLAGG-;removeDuplicates;2A;12|))
(DEFUN |CLAGG-;#;ANni;1| (|c| $)
- (LENGTH (SPADCALL |c| (|getShellEntry| $ 9))))
+ (LIST-LENGTH (SPADCALL |c| (|getShellEntry| $ 9))))
(DEFUN |CLAGG-;count;MANni;2| (|f| |c| $)
(LET ((#0=#:G1377 NIL) (#1=#:G1378 T)
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index 2fb56809..d62aab80 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -64,7 +64,7 @@
(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) |DFLOAT;pi;$;17|))
-(PUT '|DFLOAT;pi;$;17| '|SPADreplace| '(XLAM NIL PI))
+(PUT '|DFLOAT;pi;$;17| '|SPADreplace| '|%fcstpi|)
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Thing|)
|DFLOAT;coerce;$Of;18|))
@@ -470,7 +470,9 @@
(/ (FLOAT 534625820200 |$DoubleFloatMaximum|)
(FLOAT 196677847971 |$DoubleFloatMaximum|)))
-(DEFUN |DFLOAT;pi;$;17| ($) (DECLARE (IGNORE $)) PI)
+(DEFUN |DFLOAT;pi;$;17| ($)
+ (DECLARE (IGNORE $))
+ (COERCE PI 'DOUBLE-FLOAT))
(DEFUN |DFLOAT;coerce;$Of;18| (|x| $)
(SPADCALL |x| (|getShellEntry| $ 48)))
@@ -624,13 +626,15 @@
(SEQ (COND
((ZEROP |x|)
(COND
- ((PLUSP |y|) (/ PI 2))
- ((MINUSP |y|) (- (/ PI 2)))
+ ((PLUSP |y|) (/ (COERCE PI 'DOUBLE-FLOAT) 2))
+ ((MINUSP |y|) (- (/ (COERCE PI 'DOUBLE-FLOAT) 2)))
(T 0.0)))
(T (SEQ (LETT |theta| (ATAN (ABS (/ |y| |x|)))
|DFLOAT;atan;3$;79|)
(COND
- ((MINUSP |x|) (SETQ |theta| (- PI |theta|))))
+ ((MINUSP |x|)
+ (SETQ |theta|
+ (- (COERCE PI 'DOUBLE-FLOAT) |theta|))))
(COND ((MINUSP |y|) (SETQ |theta| (- |theta|))))
(EXIT |theta|))))))))
diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp
index 979c32c1..84a6ab20 100644
--- a/src/algebra/strap/EUCDOM-.lsp
+++ b/src/algebra/strap/EUCDOM-.lsp
@@ -292,7 +292,7 @@
(DEFUN |EUCDOM-;multiEuclidean;LSU;11| (|l| |z| $)
(PROG (|l1| |l2| |u| |v1| |v2|)
(RETURN
- (LET ((|n| (LENGTH |l|)))
+ (LET ((|n| (LIST-LENGTH |l|)))
(COND
((ZEROP |n|) (|error| "empty list passed to multiEuclidean"))
((EQL |n| 1) (CONS 0 (LIST |z|)))
diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp
index be7ddc88..e7e8154e 100644
--- a/src/algebra/strap/HOAGG-.lsp
+++ b/src/algebra/strap/HOAGG-.lsp
@@ -42,7 +42,7 @@
(|getShellEntry| (|getShellEntry| $$ 0) 10)))
(DEFUN |HOAGG-;#;ANni;2| (|c| $)
- (LENGTH (SPADCALL |c| (|getShellEntry| $ 15))))
+ (LIST-LENGTH (SPADCALL |c| (|getShellEntry| $ 15))))
(DEFUN |HOAGG-;any?;MAB;3| (|f| |c| $)
(LET ((#0=#:G1380 NIL) (#1=#:G1381 T)
diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp
index 70b228e2..f8d9855d 100644
--- a/src/algebra/strap/ILIST.lsp
+++ b/src/algebra/strap/ILIST.lsp
@@ -4,7 +4,7 @@
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) (|%IntegerSection| 0))
|ILIST;#;$Nni;1|))
-(PUT '|ILIST;#;$Nni;1| '|SPADreplace| 'LENGTH)
+(PUT '|ILIST;#;$Nni;1| '|SPADreplace| '|%llength|)
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%List|)
|ILIST;concat;S2$;2|))
@@ -73,12 +73,12 @@
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%List|)
|ILIST;reverse!;2$;16|))
-(PUT '|ILIST;reverse!;2$;16| '|SPADreplace| 'NREVERSE)
+(PUT '|ILIST;reverse!;2$;16| '|SPADreplace| '|%lreverse!|)
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%List|)
|ILIST;reverse;2$;17|))
-(PUT '|ILIST;reverse;2$;17| '|SPADreplace| 'REVERSE)
+(PUT '|ILIST;reverse;2$;17| '|SPADreplace| '|%lreverse|)
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Integer|)
|ILIST;minIndex;$I;18|))
@@ -121,7 +121,9 @@
|%List|)
|ILIST;mergeSort|))
-(DEFUN |ILIST;#;$Nni;1| (|x| $) (DECLARE (IGNORE $)) (LENGTH |x|))
+(DEFUN |ILIST;#;$Nni;1| (|x| $)
+ (DECLARE (IGNORE $))
+ (LIST-LENGTH |x|))
(DEFUN |ILIST;concat;S2$;2| (|s| |x| $)
(DECLARE (IGNORE $))
@@ -336,7 +338,7 @@
(EXIT |l|))))))
(DEFUN |ILIST;sort!;M2$;27| (|f| |l| $)
- (|ILIST;mergeSort| |f| |l| (LENGTH |l|) $))
+ (|ILIST;mergeSort| |f| |l| (LIST-LENGTH |l|) $))
(DEFUN |ILIST;merge!;M3$;28| (|f| |p| |q| $)
(PROG (|r| |t|)
diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp
index c0e755de..cbec4d68 100644
--- a/src/algebra/strap/LIST.lsp
+++ b/src/algebra/strap/LIST.lsp
@@ -155,7 +155,7 @@
(DEFUN |LIST;convert;$If;13| (|x| $)
(SPADCALL
(CONS (SPADCALL '|construct| (|getShellEntry| $ 47))
- (LET ((#0=#:G1419 |x|) (#1=#:G1418 NIL))
+ (LET ((#0=#:G1420 |x|) (#1=#:G1419 NIL))
(LOOP
(COND
((ATOM #0#) (RETURN (NREVERSE #1#)))
@@ -167,9 +167,9 @@
(SETQ #0# (CDR #0#)))))
(|getShellEntry| $ 52)))
-(DEFUN |List| (#0=#:G1420)
+(DEFUN |List| (#0=#:G1421)
(DECLARE (SPECIAL |$ConstructorCache|))
- (PROG (#1=#:G1421)
+ (PROG (#1=#:G1422)
(RETURN
(COND
((SETQ #1#
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index 2f459f95..ddf4ab0c 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -130,19 +130,20 @@
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
|OUTFORM;pile;L$;32|))
-(PUT '|OUTFORM;pile;L$;32| '|SPADreplace| '(XLAM (|l|) (CONS 'SC |l|)))
+(PUT '|OUTFORM;pile;L$;32| '|SPADreplace|
+ '(XLAM (|l|) (|%makepair| 'SC |l|)))
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
|OUTFORM;commaSeparate;L$;33|))
(PUT '|OUTFORM;commaSeparate;L$;33| '|SPADreplace|
- '(XLAM (|l|) (CONS 'AGGLST |l|)))
+ '(XLAM (|l|) (|%makepair| 'AGGLST |l|)))
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
|OUTFORM;semicolonSeparate;L$;34|))
(PUT '|OUTFORM;semicolonSeparate;L$;34| '|SPADreplace|
- '(XLAM (|l|) (CONS 'AGGSET |l|)))
+ '(XLAM (|l|) (|%makepair| 'AGGSET |l|)))
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
|OUTFORM;blankSeparate;L$;35|))
@@ -214,7 +215,7 @@
|OUTFORM;hconcat;L$;49|))
(PUT '|OUTFORM;hconcat;L$;49| '|SPADreplace|
- '(XLAM (|l|) (CONS 'CONCAT |l|)))
+ '(XLAM (|l|) (|%makepair| 'CONCAT |l|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;vconcat;3$;50|))
@@ -226,7 +227,7 @@
|OUTFORM;vconcat;L$;51|))
(PUT '|OUTFORM;vconcat;L$;51| '|SPADreplace|
- '(XLAM (|l|) (CONS 'VCONCAT |l|)))
+ '(XLAM (|l|) (|%makepair| 'VCONCAT |l|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;~=;3$;52|))
@@ -361,7 +362,7 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
|OUTFORM;elt;$L$;75|))
-(PUT '|OUTFORM;elt;$L$;75| '|SPADreplace| 'CONS)
+(PUT '|OUTFORM;elt;$L$;75| '|SPADreplace| '|%makepair|)
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
|OUTFORM;prefix;$L$;76|))
@@ -714,7 +715,7 @@
(DEFUN |OUTFORM;supersub;$L$;47| (|a| |l| $)
(SEQ (COND
- ((ODDP (LENGTH |l|))
+ ((ODDP (LIST-LENGTH |l|))
(SETQ |l| (APPEND |l| (LIST (|OUTFORM;empty;$;73| $))))))
(EXIT (CONS 'ALTSUPERSUB (CONS |a| |l|)))))
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index e685fb74..705c2f82 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -559,7 +559,7 @@
(|getShellEntry| $ 75))
#3#)))))
(SETQ #2# (CDR #2#)))))
- (|n| (LENGTH |d|))
+ (|n| (LIST-LENGTH |d|))
(|mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $))
(|w| (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| |n| $)))
(SEQ (SETQ |l| (CDR |l|)) (SETQ |r| (CDR |r|))
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index 1ab934bc..583b62d2 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -195,12 +195,14 @@
(SPADCALL |x| (|getShellEntry| $ 79)))
(DEFUN |SYMBOL;syprefix| (|sc| $)
- (LET ((|ns| (LIST (LENGTH (QVELT |sc| 3)) (LENGTH (QVELT |sc| 2))
- (LENGTH (QVELT |sc| 1)) (LENGTH (QVELT |sc| 0)))))
+ (LET ((|ns| (LIST (LIST-LENGTH (QVELT |sc| 3))
+ (LIST-LENGTH (QVELT |sc| 2))
+ (LIST-LENGTH (QVELT |sc| 1))
+ (LIST-LENGTH (QVELT |sc| 0)))))
(SEQ (LOOP
(COND
((NOT (COND
- ((NOT (< (LENGTH |ns|) 2))
+ ((NOT (< (LIST-LENGTH |ns|) 2))
(ZEROP (|SPADfirst| |ns|)))
(T NIL)))
(RETURN NIL))
@@ -208,7 +210,7 @@
(EXIT (SPADCALL
(CONS (STRCONC (|getShellEntry| $ 38)
(|SYMBOL;istring|
- (LENGTH (QVELT |sc| 4)) $))
+ (LIST-LENGTH (QVELT |sc| 4)) $))
(LET ((#0=#:G1524 (NREVERSE |ns|))
(#1=#:G1523 NIL))
(LOOP
@@ -569,7 +571,7 @@
((ATOM #1#) (RETURN NIL))
(T (LET ((|n| (CAR #1#)))
(COND
- ((< (LENGTH |allscripts|) |n|)
+ ((< (LIST-LENGTH |allscripts|) |n|)
(|error|
"Improper script count in symbol"))
(T (SEQ
diff --git a/src/algebra/strap/UFD-.lsp b/src/algebra/strap/UFD-.lsp
index 8cf15830..22eb430f 100644
--- a/src/algebra/strap/UFD-.lsp
+++ b/src/algebra/strap/UFD-.lsp
@@ -33,8 +33,9 @@
(|getShellEntry| $ 15)))))
(DEFUN |UFD-;prime?;SB;2| (|x| $)
- (EQL (LENGTH (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18))
- (|getShellEntry| $ 22)))
+ (EQL (LIST-LENGTH
+ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18))
+ (|getShellEntry| $ 22)))
1))
(DEFUN |UniqueFactorizationDomain&| (|#1|)
diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp
index 12a47db1..901b077d 100644
--- a/src/algebra/strap/URAGG-.lsp
+++ b/src/algebra/strap/URAGG-.lsp
@@ -469,7 +469,7 @@
(DEFUN |URAGG-;setchildren!;ALA;30| (|u| |lv| $)
(COND
- ((EQL (LENGTH |lv|) 1)
+ ((EQL (LIST-LENGTH |lv|) 1)
(SPADCALL |u| (|SPADfirst| |lv|) (|getShellEntry| $ 74)))
(T (|error| "wrong number of children specified"))))
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 4b510132..97359744 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -235,7 +235,7 @@
(LIST '|subSequence| 'SUBSEQ)
(LIST '|substitute| 'SUBST)
(LIST '|substitute!| 'NSUBST)
- (LIST '|symbolFunction| '|SYMBOL-Function|)
+ (LIST '|symbolFunction| 'SYMBOL-FUNCTION)
(LIST '|symbolName| 'SYMBOL-NAME)
(LIST '|symbolValue| 'SYMBOL-VALUE)
(LIST '|symbol?| 'SYMBOLP) (LIST '|take| 'TAKE)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 4ce7412c..0e62db1d 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -1620,7 +1620,7 @@ compJoin(["Join",:argl],m,e) ==
atom y =>
isDomainForm(y,e) => [y]
nil
- y is ['LENGTH,y'] => [y,y']
+ y is [op,y'] and op in '(LENGTH %llength) => [y,y']
[y]
x
x is ["DomainSubstitutionMacro",pl,body] =>
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 84db991f..8bed62d1 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -439,6 +439,7 @@ $VMsideEffectFreeOperators ==
QEQCAR QCDR QCAR IDENTP SYMBOLP
GREATERP ZEROP ODDP FLOAT_-RADIX FLOAT FLOAT_-SIGN
CGREATERP GGREATERP CHAR GET BVEC_-GREATER %when %false %true
+ %2bit %2bool
%and %or %not %peq %ieq %ilt %ile %igt %ige %head %tail %integer?
%beq %blt %ble %bgt %bge %bitand %bitior %bitnot %bcompl
%icst0 %icst1
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index e405f304..fb98bc83 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -349,6 +349,9 @@ expandFlt ['%flt,x,y] ==
expandFgt ['%fgt,x,y] ==
expandFlt ['%flt,y,x]
+expandFcstpi ['%fcstpi] ==
+ ['COERCE,'PI,quoteForm '%DoubleFloat]
+
-- String operations
++ string equality comparison
@@ -425,10 +428,12 @@ for x in [
-- ['%false, :'NIL],
['%true, :'T],
-- unary Boolean operations
- ['%not, :'NOT],
+ ['%not, :'NOT],
+ ['%2bit, :'TRUTH_-TO_-BIT],
+ ['%2bool, :'BIT_-TO_-TRUTH],
-- binary Boolean operations
- ['%and, :'AND],
- ['%or, :'OR],
+ ['%and, :'AND],
+ ['%or, :'OR],
-- character operations
['%ceq, :'CHAR_=],
@@ -572,6 +577,7 @@ for x in [
['%fminval, :function expandFminval],
['%fneg, :function expandFneg],
['%fprec, :function expandFprec],
+ ['%fcstpi, :function expandFcstpi],
['%streq, :function expandStreq],
['%strlt, :function expandStrlt],
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 7d87308b..1d9151d3 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -90,11 +90,12 @@ getOpCode(op,vec,max) ==
evalSlotDomain(u,dollar) ==
$returnNowhereFromGoGet: local := false
$ : fluid := dollar -- ??? substitute
- $lookupDefaults : local := nil -- new world
+ $lookupDefaults : local := false -- new world
u = '$ => dollar
u = "$$" => dollar
FIXP u =>
- vector? (y := dollar.u) => y
+ y := dollar.u
+ vector? y => y
y is ["setShellEntry",:.] => eval y
--lazy domains need to marked; this is dangerous?
y is ['SETELT,:.] => systemErrorHere "evalSlotDomain"
@@ -105,7 +106,7 @@ evalSlotDomain(u,dollar) ==
lazyDomainSet(y,dollar,u) --new style has lazyt
y
y
- u is ['NRTEVAL,y] => eval y
+ u is ['NRTEVAL,y] => eval y
u is ['QUOTE,y] => y
u is ['Record,:argl] =>
apply('Record,[[":",tag,evalSlotDomain(dom,dollar)]
@@ -114,7 +115,11 @@ evalSlotDomain(u,dollar) ==
apply('Union,[['_:,tag,evalSlotDomain(dom,dollar)]
for [.,tag,dom] in argl])
u is ["Enumeration",:.] => eval u
- u is [op,:argl] => apply(op,[evalSlotDomain(x,dollar) for x in argl])
+ cons? u =>
+ -- The domain form may value arguments, get VM form first.
+ u := expandToVMForm u
+ cons? u => apply(u.op,[evalSlotDomain(x,dollar) for x in u.args])
+ u
systemErrorHere '"evalSlotDomain"
--=======================================================
@@ -474,7 +479,8 @@ lazyMatch(source,lazyt,dollar,domain) ==
string? source and lazyt is ['QUOTE,=source] => true
integer? source =>
lazyt is ['_#, slotNum] => source = #(domain.slotNum)
- lazyt is ['%call,'LENGTH, slotNum] => source = #(domain.slotNum)
+ lazyt is ['%call,f,slotNum] and f in '(LENGTH %llength) =>
+ source = #(domain.slotNum)
nil
-- A hideous hack on the same lines as the previous four lines JHD/MCD
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-28 05:15:53 +0000