aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/interp/ChangeLog43
-rw-r--r--src/interp/Makefile.in85
-rw-r--r--src/interp/Makefile.pamphlet146
-rw-r--r--src/interp/daase.lisp.pamphlet9
-rw-r--r--src/interp/g-cndata.boot.pamphlet5
-rw-r--r--src/interp/g-opt.boot.pamphlet56
-rw-r--r--src/interp/g-timer.boot.pamphlet4
-rw-r--r--src/interp/g-util.boot.pamphlet1
-rw-r--r--src/interp/ht-root.boot.pamphlet64
-rw-r--r--src/interp/ht-util.boot.pamphlet4
-rw-r--r--src/interp/htcheck.boot.pamphlet4
-rw-r--r--src/interp/htsetvar.boot.pamphlet3
-rw-r--r--src/interp/hypertex.boot.pamphlet25
-rw-r--r--src/interp/profile.boot.pamphlet5
-rw-r--r--src/interp/rulesets.boot.pamphlet27
-rw-r--r--src/interp/setq.lisp.pamphlet1
-rw-r--r--src/interp/spad.lisp.pamphlet20
-rw-r--r--src/interp/sys-constants.boot10
-rw-r--r--src/interp/sys-globals.boot5
-rw-r--r--src/interp/sys-macros.lisp18
20 files changed, 273 insertions, 262 deletions
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog
index 00864911..4bcaf00e 100644
--- a/src/interp/ChangeLog
+++ b/src/interp/ChangeLog
@@ -1,5 +1,48 @@
2007-10-11 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * Makefile.pamphlet (${DEPSYS}): Depend on g-util.$(FASLEXT).
+ Load explicitly.
+ (<<profile.clisp>>): Remove.
+ (<<g-cndata.clisp>>): Likewise.
+ (<<g-opt.clisp>>): Likewise.
+ (<<g-timer.clisp>>): Likewise.
+ (<<hypertex.clisp>>): Likewise.
+ (<<rulesets.clisp>>): Likewise.
+ (<<ht-util.clisp>>): Likewise.
+ (<<htsetvar.clisp>>): Likewise.
+ (<<ht-root.clisp>>): Likewise.
+ (<<htcheck.clisp>>): Likewise.
+ (ht-root.$(FASLEXT)): New rule.
+ (htcheck.$(FASLEXT)): Likewise.
+ (ht-util.$(FASLEXT)): Likewise.
+ (htsetvar.$(FASLEXT)): Likewise.
+ (hypertex.$(FASLEXT)): Likewise.
+ (profile.$(FASLEXT)): Likewise.
+ (rulesets.$(FASLEXT)): Likewise.
+ (g-opt.$(FASLEXT)): Likewise.
+ (g-timer.$(FASLEXT)): Likewise.
+ (g-util.$(FASLEXT)): Likewise.
+ (g-cndata.$(FASLEXT)): Likewise.
+ * daase.lisp.pamphlet (*attributes*): Move definition to
+ sys-constants.boot.
+ * g-cndata.boot.pamphlet: Push into package "BOOT". Fix syntax.
+ * g-opt.boot.pamphlet: Likewise.
+ (EqualBarGensym): Fix thinko.
+ * g-timer.boot.pamphlet: Push into package "BOOT".
+ * g-util.boot.pamphlet: Likewise.
+ * ht-root.boot.pamphlet: Likewise. Fix syntax.
+ * ht-util.boot.pamphlet: Push into package "BOOT".
+ * htcheck.boot.pamphlet: Likewise.
+ * htsetvar.boot.pamphlet: Likewise.
+ * hypertex.boot.pamphlet: Likewise. Fix syntax.
+ * profile.boot.pamphlet: Likewise.
+ * rulesets.boot.pamphlet: Likewise.
+ * setq.lisp.pamphlet (/VERSION): Move definition to sys-globals.boot.
+ * spad.lisp.pamphlet (/WSNAME): Likewise.
+ (|rplac|): Move to sys-macros.boot.
+
+2007-10-11 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* Makefile.pamphlet (<<nag-c02.clisp>>): Remove.
(<<nag-c05.clisp>>): Likewise.
(<<nag-c06.clisp>>): Likewise.
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 49ea5a0a..827626b3 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -364,7 +364,7 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \
fnewmeta.$(FASLEXT) \
g-error.clisp \
g-boot.clisp c-util.${LISP} \
- g-util.clisp \
+ g-util.$(FASLEXT) \
clam.clisp \
slam.clisp
@ echo 3 making ${DEPSYS}
@@ -405,12 +405,11 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \
@ echo '(load "g-boot")' >> makedep.lisp
@ echo '(unless (probe-file "c-util.$(FASLEXT)") (|compileLispFile| "c-util.${LISP}" "c-util.$(FASLEXT)"))' >> makedep.lisp
@ echo '(load "c-util")' >> makedep.lisp
- @ echo '(unless (probe-file "g-util.$(FASLEXT)") (|compileLispFile| "g-util.clisp" "g-util.$(FASLEXT)"))' >> makedep.lisp
- @ echo '(load "g-util")' >> makedep.lisp
+ @ echo '(|importModule| "g-util")' >> makedep.lisp
../lisp/base-lisp$(EXEEXT) -- --make --output=$@ \
--load-directory=. makedep.lisp
@rm $(addsuffix .$(FASLEXT), \
- clam slam g-error g-boot c-util g-util)
+ clam slam g-error g-boot c-util)
@ echo 4 ${DEPSYS} created
@@ -453,6 +452,31 @@ database.date:
$(AUTO)/%.$(FASLEXT): %.$(FASLEXT)
$(INSTALL) $< $@
+## HyperDoc
+ht-root.$(FASLEXT): ht-root.boot ht-util.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+htcheck.$(FASLEXT): htcheck.boot sys-driver.$(FASLEXT) macros.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+ht-util.$(FASLEXT): ht-util.boot macros.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+htsetvar.$(FASLEXT): htsetvar.boot macros.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+hypertex.$(FASLEXT): hypertex.boot boot-pkg.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+## OpenAxiom's interpreter.
+
+profile.$(FASLEXT): profile.boot macros.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+rulesets.$(FASLEXT): rulesets.boot vmlisp.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+
##
## OpenAxiom's front-end consists of two parts:
## (a) the interprerter's parser -- also referred to as new parser
@@ -555,6 +579,19 @@ dq.$(FASLEXT): dq.boot boot-pkg.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
## General support and utilities.
+
+g-opt.$(FASLEXT): g-opt.boot def.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+g-timer.$(FASLEXT): g-timer.boot macros.$(FASLEXT) g-util.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+g-util.$(FASLEXT): g-util.boot macros.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+g-cndata.$(FASLEXT): g-cndata.boot sys-macros.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
sys-macros.$(FASLEXT): sys-macros.lisp diagnostics.$(FASLEXT) \
union.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
@@ -687,38 +724,6 @@ functor.clisp: functor.boot
@ echo 254 making $@ from $<
@ echo '(old-boot::boot "functor.boot")' | ${DEPSYS}
-g-cndata.clisp: g-cndata.boot
- @ echo 261 making $@ from $<
- @ echo '(old-boot::boot "g-cndata.boot")' | ${DEPSYS}
-
-g-opt.clisp: g-opt.boot
- @ echo 267 making $@ from $<
- @ echo '(old-boot::boot "g-opt.boot")' | ${DEPSYS}
-
-g-timer.clisp: g-timer.boot
- @ echo 270 making $@ from $<
- @ echo '(old-boot::boot "g-timer.boot")' | ${DEPSYS}
-
-htcheck.clisp: htcheck.boot
- @ echo 455 making $@ from $<
- @ echo '(old-boot::boot "htcheck.boot")' | ${DEPSYS}
-
-ht-root.clisp: ht-root.boot
- @ echo 451 making $@ from $<
- @ echo '(old-boot::boot "ht-root.boot")' | ${DEPSYS}
-
-htsetvar.clisp: htsetvar.boot
- @ echo 444 making $@ from $<
- @ echo '(old-boot::boot "htsetvar.boot")' | ${DEPSYS}
-
-ht-util.clisp: ht-util.boot
- @ echo 440 making $@ from $<
- @ echo '(old-boot::boot "ht-util.boot")' | ${DEPSYS}
-
-hypertex.clisp: hypertex.boot
- @ echo 277 making $@ from $<
- @ echo '(old-boot::boot "hypertex.boot")' | ${DEPSYS}
-
i-analy.clisp: i-analy.boot
@ echo 280 making $@ from $<
@ echo '(old-boot::boot "i-analy.boot")' | ${DEPSYS}
@@ -823,18 +828,10 @@ nrunopt.clisp: nrunopt.boot
@ echo 365 making $@ from $<
@ echo '(old-boot::boot "nrunopt.boot")' | ${DEPSYS}
-profile.clisp: profile.boot
- @ echo 237 making $@ from $<
- @ echo '(old-boot::boot "profile.boot")' | ${DEPSYS}
-
record.clisp: record.boot
@ echo 447 making $@ $<
@ echo '(old-boot::boot "record.boot")' | ${DEPSYS}
-rulesets.clisp: rulesets.boot
- @ echo 388 making $@ from $<
- @ echo '(old-boot::boot "rulesets.boot")' | ${DEPSYS}
-
server.clisp: server.boot
@ echo 391 making $@ from $<
@ echo '(old-boot::boot "server.boot")' | ${DEPSYS}
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index ebec650c..54889009 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -994,7 +994,7 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \
fnewmeta.$(FASLEXT) \
g-error.clisp \
g-boot.clisp c-util.${LISP} \
- g-util.clisp \
+ g-util.$(FASLEXT) \
clam.clisp \
slam.clisp
@ echo 3 making ${DEPSYS}
@@ -1035,11 +1035,10 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \
@ echo '(load "g-boot")' >> makedep.lisp
@ echo '(unless (probe-file "c-util.$(FASLEXT)") (|compileLispFile| "c-util.${LISP}" "c-util.$(FASLEXT)"))' >> makedep.lisp
@ echo '(load "c-util")' >> makedep.lisp
- @ echo '(unless (probe-file "g-util.$(FASLEXT)") (|compileLispFile| "g-util.clisp" "g-util.$(FASLEXT)"))' >> makedep.lisp
- @ echo '(load "g-util")' >> makedep.lisp
+ @ echo '(|importModule| "g-util")' >> makedep.lisp
<<save depsys image>>
@rm $(addsuffix .$(FASLEXT), \
- clam slam g-error g-boot c-util g-util)
+ clam slam g-error g-boot c-util)
@ echo 4 ${DEPSYS} created
@@ -1225,14 +1224,6 @@ compiler.clisp: compiler.boot
@ echo '(old-boot::boot "compiler.boot")' | ${DEPSYS}
@
-\subsection{profile.boot \cite{65}}
-
-<<profile.clisp>>=
-profile.clisp: profile.boot
- @ echo 237 making $@ from $<
- @ echo '(old-boot::boot "profile.boot")' | ${DEPSYS}
-@
-
\subsection{database.boot \cite{67}}
<<database.clisp>>=
@@ -1265,39 +1256,6 @@ functor.clisp: functor.boot
@ echo '(old-boot::boot "functor.boot")' | ${DEPSYS}
@
-\subsection{g-cndata.boot}
-
-<<g-cndata.clisp>>=
-g-cndata.clisp: g-cndata.boot
- @ echo 261 making $@ from $<
- @ echo '(old-boot::boot "g-cndata.boot")' | ${DEPSYS}
-@
-
-\subsection{g-opt.boot}
-
-<<g-opt.clisp>>=
-g-opt.clisp: g-opt.boot
- @ echo 267 making $@ from $<
- @ echo '(old-boot::boot "g-opt.boot")' | ${DEPSYS}
-@
-
-\subsection{g-timer.boot}
-
-<<g-timer.clisp>>=
-g-timer.clisp: g-timer.boot
- @ echo 270 making $@ from $<
- @ echo '(old-boot::boot "g-timer.boot")' | ${DEPSYS}
-@
-
-
-\subsection{hypertex.boot}
-
-<<hypertex.clisp>>=
-hypertex.clisp: hypertex.boot
- @ echo 277 making $@ from $<
- @ echo '(old-boot::boot "hypertex.boot")' | ${DEPSYS}
-@
-
\subsection{i-analy.boot}
<<i-analy.clisp>>=
@@ -1536,14 +1494,6 @@ if these two things are done then a DEPSYS image can be bootstrapped
to a new platform.
\end{verbatim}
-\subsection{rulesets.boot}
-
-<<rulesets.clisp>>=
-rulesets.clisp: rulesets.boot
- @ echo 388 making $@ from $<
- @ echo '(old-boot::boot "rulesets.boot")' | ${DEPSYS}
-@
-
\subsection{server.boot}
<<server.clisp>>=
@@ -1585,22 +1535,6 @@ bc-solve.clisp: bc-solve.boot
@ echo '(old-boot::boot "bc-solve.boot")' | ${DEPSYS}
@
-\subsection{ht-util.boot}
-
-<<ht-util.clisp>>=
-ht-util.clisp: ht-util.boot
- @ echo 440 making $@ from $<
- @ echo '(old-boot::boot "ht-util.boot")' | ${DEPSYS}
-@
-
-\subsection{htsetvar.boot}
-
-<<htsetvar.clisp>>=
-htsetvar.clisp: htsetvar.boot
- @ echo 444 making $@ from $<
- @ echo '(old-boot::boot "htsetvar.boot")' | ${DEPSYS}
-@
-
\subsection{record.boot}
<<record.clisp>>=
@@ -1609,22 +1543,6 @@ record.clisp: record.boot
@ echo '(old-boot::boot "record.boot")' | ${DEPSYS}
@
-\subsection{ht-root.boot}
-
-<<ht-root.clisp>>=
-ht-root.clisp: ht-root.boot
- @ echo 451 making $@ from $<
- @ echo '(old-boot::boot "ht-root.boot")' | ${DEPSYS}
-@
-
-\subsection{htcheck.boot}
-
-<<htcheck.clisp>>=
-htcheck.clisp: htcheck.boot
- @ echo 455 making $@ from $<
- @ echo '(old-boot::boot "htcheck.boot")' | ${DEPSYS}
-@
-
\subsection{ax.boot}
<<ax.clisp>>=
@@ -1788,6 +1706,31 @@ distclean-local: clean-local
$(AUTO)/%.$(FASLEXT): %.$(FASLEXT)
$(INSTALL) $< $@
+## HyperDoc
+ht-root.$(FASLEXT): ht-root.boot ht-util.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+htcheck.$(FASLEXT): htcheck.boot sys-driver.$(FASLEXT) macros.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+ht-util.$(FASLEXT): ht-util.boot macros.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+htsetvar.$(FASLEXT): htsetvar.boot macros.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+hypertex.$(FASLEXT): hypertex.boot boot-pkg.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+## OpenAxiom's interpreter.
+
+profile.$(FASLEXT): profile.boot macros.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+rulesets.$(FASLEXT): rulesets.boot vmlisp.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+
##
## OpenAxiom's front-end consists of two parts:
## (a) the interprerter's parser -- also referred to as new parser
@@ -1890,6 +1833,19 @@ dq.$(FASLEXT): dq.boot boot-pkg.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
## General support and utilities.
+
+g-opt.$(FASLEXT): g-opt.boot def.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+g-timer.$(FASLEXT): g-timer.boot macros.$(FASLEXT) g-util.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+g-util.$(FASLEXT): g-util.boot macros.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+g-cndata.$(FASLEXT): g-cndata.boot sys-macros.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
sys-macros.$(FASLEXT): sys-macros.lisp diagnostics.$(FASLEXT) \
union.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
@@ -1970,22 +1926,6 @@ boot-pkg.$(FASLEXT): boot-pkg.lisp
<<functor.clisp>>
-<<g-cndata.clisp>>
-
-<<g-opt.clisp>>
-
-<<g-timer.clisp>>
-
-<<htcheck.clisp>>
-
-<<ht-root.clisp>>
-
-<<htsetvar.clisp>>
-
-<<ht-util.clisp>>
-
-<<hypertex.clisp>>
-
<<i-analy.clisp>>
<<i-code.clisp>>
@@ -2038,12 +1978,8 @@ boot-pkg.$(FASLEXT): boot-pkg.lisp
<<nrunopt.clisp>>
-<<profile.clisp>>
-
<<record.clisp>>
-<<rulesets.clisp>>
-
<<server.clisp>>
<<setvart.clisp>>
diff --git a/src/interp/daase.lisp.pamphlet b/src/interp/daase.lisp.pamphlet
index 670197e8..018e6758 100644
--- a/src/interp/daase.lisp.pamphlet
+++ b/src/interp/daase.lisp.pamphlet
@@ -1292,15 +1292,6 @@ short negative numbers.
(setq *compressvector*
(make-array (car lst) :initial-contents (cdr lst))))))
-(setq *attributes*
- '(|nil| |infinite| |arbitraryExponent| |approximate| |complex|
- |shallowMutable| |canonical| |noetherian| |central|
- |partiallyOrderedSet| |arbitraryPrecision| |canonicalsClosed|
- |noZeroDivisors| |rightUnitary| |leftUnitary|
- |additiveValuation| |unitsKnown| |canonicalUnitNormal|
- |multiplicativeValuation| |finiteAggregate| |shallowlyMutable|
- |commutative|))
-
(defun write-compress ()
(let (compresslist masterpos out)
(close *compress-stream*)
diff --git a/src/interp/g-cndata.boot.pamphlet b/src/interp/g-cndata.boot.pamphlet
index 7e09df96..6c0efdac 100644
--- a/src/interp/g-cndata.boot.pamphlet
+++ b/src/interp/g-cndata.boot.pamphlet
@@ -46,6 +46,9 @@
<<*>>=
<<license>>
+import '"sys-macros"
+)package "BOOT"
+
--% Manipulation of Constructor Datat
--=======================================================================
@@ -241,7 +244,7 @@ condUnabbrev(op,arglist,argtypes,modeIfTrue) ==
#arglist ^= #argtypes =>
throwKeyedMsg("S2IL0014",[op,plural(#argtypes,'"argument"),
bright(#arglist)])
- [newArg for arg in arglist for type in argtypes] where newArg ==
+ [newArg for arg in arglist for type in argtypes] where newArg() ==
categoryForm?(type) => unabbrev1(arg,modeIfTrue)
arg
diff --git a/src/interp/g-opt.boot.pamphlet b/src/interp/g-opt.boot.pamphlet
index 33fad9dd..cb16c275 100644
--- a/src/interp/g-opt.boot.pamphlet
+++ b/src/interp/g-opt.boot.pamphlet
@@ -46,6 +46,10 @@
<<*>>=
<<license>>
+import '"def"
+
+)package "BOOT"
+
--% OPTIMIZER
optimizeFunctionDef(def) ==
@@ -119,12 +123,12 @@ optCatch (x is ["CATCH",g,a]) ==
changeThrowToExit(rest s,g)
rplac(rest a,[:s,["EXIT",u]])
["CATCH",y,a]:= optimize x
- if hasNoThrows(a,g)
- then (rplac(first x,first a); rplac(rest x,rest a)) where
- hasNoThrows(a,g) ==
- a is ["THROW", =g,:.] => false
- atom a => true
- hasNoThrows(first a,g) and hasNoThrows(rest a,g)
+ if hasNoThrows(a,g) where
+ hasNoThrows(a,g) ==
+ a is ["THROW", =g,:.] => false
+ atom a => true
+ hasNoThrows(first a,g) and hasNoThrows(rest a,g)
+ then (rplac(first x,first a); rplac(rest x,rest a))
else
changeThrowToGo(a,g) where
changeThrowToGo(s,g) ==
@@ -264,7 +268,7 @@ AssocBarGensym(key,l) ==
EqualBarGensym(key,CAR x) => return x
EqualBarGensym(x,y) ==
- $GensymAssoc: nil
+ $GensymAssoc: fluid
fn(x,y) where
fn(x,y) ==
x=y => true
@@ -391,27 +395,23 @@ optEQ u ==
u
u
-EVALANDFILEACTQ
- (
- for x in '( (call optCall) _
- (SEQ optSEQ)_
- (EQ optEQ)
- (MINUS optMINUS)_
- (QSMINUS optQSMINUS)_
- (_- opt_-)_
- (LESSP optLESSP)_
- (SPADCALL optSPADCALL)_
- (_| optSuchthat)_
- (CATCH optCatch)_
- (COND optCond)_
- (mkRecord optMkRecord)_
- (RECORDELT optRECORDELT)_
- (SETRECORDELT optSETRECORDELT)_
- (RECORDCOPY optRECORDCOPY)) _
- repeat MAKEPROP(CAR x,'OPTIMIZE,CREATE_-SBC CADR x)
- --much quicker to call functions if they have an SBC
- )
-
+for x in '( (call optCall) _
+ (SEQ optSEQ)_
+ (EQ optEQ)
+ (MINUS optMINUS)_
+ (QSMINUS optQSMINUS)_
+ (_- opt_-)_
+ (LESSP optLESSP)_
+ (SPADCALL optSPADCALL)_
+ (_| optSuchthat)_
+ (CATCH optCatch)_
+ (COND optCond)_
+ (mkRecord optMkRecord)_
+ (RECORDELT optRECORDELT)_
+ (SETRECORDELT optSETRECORDELT)_
+ (RECORDCOPY optRECORDCOPY)) _
+ repeat MAKEPROP(CAR x,'OPTIMIZE,CREATE_-SBC CADR x)
+ --much quicker to call functions if they have an SBC
@
\eject
diff --git a/src/interp/g-timer.boot.pamphlet b/src/interp/g-timer.boot.pamphlet
index 513e367d..6b060ddc 100644
--- a/src/interp/g-timer.boot.pamphlet
+++ b/src/interp/g-timer.boot.pamphlet
@@ -46,6 +46,10 @@
<<*>>=
<<license>>
+import '"macros"
+import '"g-util"
+)package "BOOT"
+
--% Code instrumentation facilities
-- These functions can be used with arbitrary lists of
-- named stats (listofnames) grouped in classes (listofclasses)
diff --git a/src/interp/g-util.boot.pamphlet b/src/interp/g-util.boot.pamphlet
index 05e262c8..fc247aee 100644
--- a/src/interp/g-util.boot.pamphlet
+++ b/src/interp/g-util.boot.pamphlet
@@ -50,6 +50,7 @@
<<*>>=
<<license>>
+import '"macros"
)package "BOOT"
--% Utility Functions of General Use
diff --git a/src/interp/ht-root.boot.pamphlet b/src/interp/ht-root.boot.pamphlet
index e8c27ee0..9ec1bbf3 100644
--- a/src/interp/ht-root.boot.pamphlet
+++ b/src/interp/ht-root.boot.pamphlet
@@ -46,6 +46,9 @@
<<*>>=
<<license>>
+import '"ht-util"
+)package "BOOT"
+
$historyDisplayWidth := 120
$newline := char 10
@@ -72,7 +75,7 @@ dbNonEmptyPattern pattern ==
'"*"
htSystemVariables() == main where
- main ==
+ main() ==
not $fullScreenSysVars => htSetVars()
classlevel := $UserLevel
$levels : local := '(compiler development interpreter)
@@ -102,35 +105,36 @@ htSystemVariables() == main where
displayOptions(name,key,variable,val,options)
htSay '"\endmenu"
htShowPage()
- functionTail(name,class,var,valuesOrFunction) ==
- val := eval var
- atom valuesOrFunction =>
- htMakePage '((domainConditions (isDomain STR (String))))
- htMakePage [['bcLinks,['"reset",'"",'htSetSystemVariableKind,[var,name,nil]]]]
- htMakePage [['bcStrings,[30,STRINGIMAGE val,name,valuesOrFunction]]]
- displayOptions(name,class,var,val,valuesOrFunction)
- displayOptions(name,class,variable,val,options) ==
- class = 'INTEGER =>
- htMakePage [['bcLispLinks,[[['text,options.0,'"-",options.1 or '""]],'"",'htSetSystemVariableKind,[variable,name,'PARSE_-INTEGER]]]]
- htMakePage '((domainConditions (isDomain INT (Integer))))
- htMakePage [['bcStrings,[5,STRINGIMAGE val,name,'INT]]]
- class = 'STRING =>
- htSay('"{\em ",val,'"}\space{1}")
- for x in options repeat
- val = x or val = true and x = 'on or null val and x = 'off =>
- htSay('"{\em ",x,'"}\space{1}")
- htMakePage [['bcLispLinks,[x,'" ",'htSetSystemVariable,[variable,x]]]]
- fn(t,al,firstTime) ==
- atom t => al
- if firstTime then $heading := opOf first t
- fn(rest t,gn(first t,al),firstTime)
- gn(t,al) ==
- [.,.,class,key,.,options,:.] := t
- not MEMQ(class,$levels) => al
- key = 'LITERALS or key = 'INTEGER or key = 'STRING => [[$heading,:t],:al]
- key = 'TREE => fn(options,al,false)
- key = 'FUNCTION => [[$heading,:t],:al]
- systemError key
+ where
+ functionTail(name,class,var,valuesOrFunction) ==
+ val := eval var
+ atom valuesOrFunction =>
+ htMakePage '((domainConditions (isDomain STR (String))))
+ htMakePage [['bcLinks,['"reset",'"",'htSetSystemVariableKind,[var,name,nil]]]]
+ htMakePage [['bcStrings,[30,STRINGIMAGE val,name,valuesOrFunction]]]
+ displayOptions(name,class,var,val,valuesOrFunction)
+ displayOptions(name,class,variable,val,options) ==
+ class = 'INTEGER =>
+ htMakePage [['bcLispLinks,[[['text,options.0,'"-",options.1 or '""]],'"",'htSetSystemVariableKind,[variable,name,'PARSE_-INTEGER]]]]
+ htMakePage '((domainConditions (isDomain INT (Integer))))
+ htMakePage [['bcStrings,[5,STRINGIMAGE val,name,'INT]]]
+ class = 'STRING =>
+ htSay('"{\em ",val,'"}\space{1}")
+ for x in options repeat
+ val = x or val = true and x = 'on or null val and x = 'off =>
+ htSay('"{\em ",x,'"}\space{1}")
+ htMakePage [['bcLispLinks,[x,'" ",'htSetSystemVariable,[variable,x]]]]
+ fn(t,al,firstTime) ==
+ atom t => al
+ if firstTime then $heading := opOf first t
+ fn(rest t,gn(first t,al),firstTime)
+ gn(t,al) ==
+ [.,.,class,key,.,options,:.] := t
+ not MEMQ(class,$levels) => al
+ key = 'LITERALS or key = 'INTEGER or key = 'STRING => [[$heading,:t],:al]
+ key = 'TREE => fn(options,al,false)
+ key = 'FUNCTION => [[$heading,:t],:al]
+ systemError key
htSetSystemVariableKind(htPage,[variable,name,fun]) ==
value := htpLabelInputString(htPage,name)
diff --git a/src/interp/ht-util.boot.pamphlet b/src/interp/ht-util.boot.pamphlet
index f875959f..3c7cbf73 100644
--- a/src/interp/ht-util.boot.pamphlet
+++ b/src/interp/ht-util.boot.pamphlet
@@ -46,8 +46,10 @@
<<*>>=
<<license>>
+import '"macros"
+)package "BOOT"
+
-- HyperTeX Utilities for generating basic Command pages
---)package "BOOT"
$bcParseOnly := true
diff --git a/src/interp/htcheck.boot.pamphlet b/src/interp/htcheck.boot.pamphlet
index c78a8db6..82f67b3a 100644
--- a/src/interp/htcheck.boot.pamphlet
+++ b/src/interp/htcheck.boot.pamphlet
@@ -50,6 +50,10 @@
<<*>>=
<<license>>
+import '"sys-driver"
+import '"macros"
+)package "BOOT"
+
$primitiveHtCommands := '(
("\ContinueButton" . 1)
("\andexample" . 1)
diff --git a/src/interp/htsetvar.boot.pamphlet b/src/interp/htsetvar.boot.pamphlet
index 0d664ff9..4cf78735 100644
--- a/src/interp/htsetvar.boot.pamphlet
+++ b/src/interp/htsetvar.boot.pamphlet
@@ -46,6 +46,9 @@
<<*>>=
<<license>>
+import '"macros"
+)package "BOOT"
+
htsv() ==
startHTPage(50)
htSetVars()
diff --git a/src/interp/hypertex.boot.pamphlet b/src/interp/hypertex.boot.pamphlet
index 430abc4e..208f8aa7 100644
--- a/src/interp/hypertex.boot.pamphlet
+++ b/src/interp/hypertex.boot.pamphlet
@@ -46,20 +46,23 @@
<<*>>=
<<license>>
+import '"boot-pkg"
+)package "BOOT"
+
-- HyperTex Spad interface
-- SETANDFILEQ($SendXEventToHyperTeX, 8)
-SETANDFILEQ($LinkToPage, 96)
-SETANDFILEQ($StartPage, 97)
-SETANDFILEQ($SendLine, 98)
-SETANDFILEQ($EndOfPage, 99)
-SETANDFILEQ($PopUpPage, 95)
-SETANDFILEQ($PopUpNamedPage, 94)
-SETANDFILEQ($KillPage, 93)
-SETANDFILEQ($ReplacePage, 92)
-SETANDFILEQ($ReplaceNamedPage, 91)
-SETANDFILEQ($SpadError, 90)
-SETANDFILEQ($PageStuff, 100)
+$LinkToPage == 96
+$StartPage == 97
+$SendLine == 98
+$EndOfPage == 99
+$PopUpPage == 95
+$PopUpNamedPage == 94
+$KillPage == 93
+$ReplacePage == 92
+$ReplaceNamedPage == 91
+$SpadError == 90
+$PageStuff == 100
diff --git a/src/interp/profile.boot.pamphlet b/src/interp/profile.boot.pamphlet
index e3b83f66..f6d858d9 100644
--- a/src/interp/profile.boot.pamphlet
+++ b/src/interp/profile.boot.pamphlet
@@ -46,12 +46,15 @@
<<*>>=
<<license>>
+import '"macros"
+)package "BOOT"
+
--$profileCompiler := true
$profileAlist := nil
profileWrite() == --called from finalizeLisplib
outStream := MAKE_-OUTSTREAM CONCAT(LIBSTREAM_-DIRNAME $libFile,'"/info")
- _*PRINT_-PRETTY_* :local := 'T
+ SETQ(_*PRINT_-PRETTY_*, true)
PRINT_-FULL(profileTran $profileAlist,outStream)
SHUT outStream
diff --git a/src/interp/rulesets.boot.pamphlet b/src/interp/rulesets.boot.pamphlet
index b2ceefa6..9c1ccd82 100644
--- a/src/interp/rulesets.boot.pamphlet
+++ b/src/interp/rulesets.boot.pamphlet
@@ -46,6 +46,9 @@
<<*>>=
<<license>>
+import '"vmlisp"
+)package "BOOT"
+
--% Mode and Type Resolution Rule Data and Ruleset Creation
--% resolveTT Rules
@@ -62,7 +65,7 @@
-- These first rules will be expanded for each of MP, DMP and NDMP
-SETANDFILEQ($mpolyTTRules,'( _
+$mpolyTTRules == '( _
((Resolve (RN) (mpoly1 x t1)) . (mpoly1 x (Resolve (RN) t1))) _
((Resolve (UP x t1) (mpoly1 y t2)) . _
(Resolve t1 (mpoly1 (Incl x y) t2))) _
@@ -79,11 +82,11 @@ SETANDFILEQ($mpolyTTRules,'( _
((Resolve (mpoly1 x t1) (mpoly1 y t2)) . _
(mpoly1 (SetInter x y) (Resolve _
(mpoly1 (SetDiff x y) t1) (mpoly1 (SetDiff y x) t2)))) _
- ))
+ )
-- These are the general rules, excluding those above.
-SETANDFILEQ($generalTTRules, '( _
+$generalTTRules == '( _
((Resolve (L (L t1)) (M t2)) . (M (Resolve t1 t2))) _
((Resolve (EQ t1) (B)) . (B)) _
((Resolve (SY) t1) . (Resolve (P (I)) t1)) _
@@ -149,7 +152,7 @@ SETANDFILEQ($generalTTRules, '( _
((Resolve (DMP x t1) (NDMP y t2)) . _
(DMP (SetInter x y) (Resolve _
(DMP (SetDiff x y) t1) (NDMP (SetDiff y x) t2)))) _
- ))
+ )
-- The following creates the ruleset
@@ -169,7 +172,7 @@ createResolveTTRules() ==
-- These first rules will be expanded for each of MP, DMP and NDMP
-SETANDFILEQ($mpolyTMRules,'( _
+$mpolyTMRules == '( _
((Resolve (mpoly1 x t1) (P t2)) . (Resolve t1 (P t2))) _
((Resolve (mpoly1 (x) t1) (UP x t2)) . (UP x (Resolve t1 t2))) _
((Resolve (mpoly1 x t1) (UP y t2)) . _
@@ -184,11 +187,11 @@ SETANDFILEQ($mpolyTMRules,'( _
(mpoly2 y (Resolve (mpoly1 (SetComp x y) t1) t2))) _
((Resolve (mpoly1 x t1) (mpoly2 y t2)) . _
(Resolve (mpoly1 (SetDiff x y) t1) (mpoly2 y t2))) _
- ))
+ )
-- These are the general rules, excluding those above.
-SETANDFILEQ($generalTMRules,'( _
+$generalTMRules == '( _
((Resolve (VARIABLE x) (P t1)) . (P (Resolve (I) t1))) _
((Resolve (VARIABLE x) (UP y t1)) . _
(UP (VarEqual x y) (Resolve (I) t1))) _
@@ -227,10 +230,10 @@ SETANDFILEQ($generalTMRules,'( _
((Resolve (V t1) (L t2)) . (L (Resolve t1 t2))) _
((Resolve (FF t1) (FR t2)) . (FR (Resolve t1 t2))) _
((Resolve (UP x t1) (P t2)) . (Resolve t1 (P t2))) _
- ))
+ )
-- Private abbreviation table for resolve rules
-SETANDFILEQ($resolveAbbreviations, '( _
+$resolveAbbreviations == '( _
(P . Polynomial) _
(G . Gaussian) _
(L . List) _
@@ -260,9 +263,9 @@ SETANDFILEQ($resolveAbbreviations, '( _
(ELFPS . EllipticFunctionPowerSeries) _
(EF . ElementaryFunction) _
(VARIABLE . Variable) _
- ))
+ )
-SETANDFILEQ($newResolveAbbreviations, '( _
+$newResolveAbbreviations == '( _
(P . Polynomial) _
(G . Complex) _
(L . List) _
@@ -285,7 +288,7 @@ SETANDFILEQ($newResolveAbbreviations, '( _
(QF . Fraction) _
(UPS . UnivariatePowerSeries) _
(VARIABLE . Variable) _
- ))
+ )
-- The following creates the ruleset
diff --git a/src/interp/setq.lisp.pamphlet b/src/interp/setq.lisp.pamphlet
index ae3011b7..6e8e580a 100644
--- a/src/interp/setq.lisp.pamphlet
+++ b/src/interp/setq.lisp.pamphlet
@@ -62,7 +62,6 @@
(in-package "BOOT")
(SETQ |/MAJOR-VERSION| 7)
-(SETQ /VERSION 0)
(SETQ /RELEASE 0)
(defconstant |$cclSystem|
diff --git a/src/interp/spad.lisp.pamphlet b/src/interp/spad.lisp.pamphlet
index 010aa043..da3cd6a4 100644
--- a/src/interp/spad.lisp.pamphlet
+++ b/src/interp/spad.lisp.pamphlet
@@ -102,7 +102,7 @@
(defvar INPUTSTREAM t "bogus initialization for now")
(defvar |boot-NewKEY| NIL)
-(setq /WSNAME 'NOBOOT)
+
(DEFVAR _ '&)
(defvar /EDIT-FM 'A1)
(defvar /EDIT-FT 'SPAD)
@@ -471,24 +471,6 @@
(defun SETELTREST (A B C) (declare (ignore b)) (RPLACD A C))
-(defmacro |rplac| (&rest L)
- (let (a b s)
- (cond
- ((EQCAR (SETQ A (CAR L)) 'ELT)
- (COND ((AND (INTEGERP (SETQ B (CADDR A))) (>= B 0))
- (SETQ S "CA")
- (do ((i 1 (1+ i))) ((> i b)) (SETQ S (STRCONC S "D")))
- (LIST 'RPLAC (LIST (INTERN (STRCONC S "R")) (CADR A)) (CADR L)))
- ((ERROR "rplac"))))
- ((PROGN
- (SETQ A (CARCDREXPAND (CAR L) NIL))
- (SETQ B (CADR L))
- (COND
- ((CDDR L) (ERROR 'RPLAC))
- ((EQCAR A 'CAR) (LIST 'RPLACA (CADR A) B))
- ((EQCAR A 'CDR) (LIST 'RPLACD (CADR A) B))
- ((ERROR 'RPLAC))))))))
-
(DEFUN ASSOCIATER (FN LST)
(COND ((NULL LST) NIL)
((NULL (CDR LST)) (CAR LST))
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index 3f75d77e..7e15b01f 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -568,3 +568,13 @@ $FILETYPE_-TABLE ==
["SPADFORM", :"sform"],
["SPADTEX", :"stex"],
["SPADOUT", :"spout"]]
+
++++
+_*ATTRIBUTES_* ==
+ '(nil infinite arbitraryExponent approximate complex
+ shallowMutable canonical noetherian central
+ partiallyOrderedSet arbitraryPrecision canonicalsClosed
+ noZeroDivisors rightUnitary leftUnitary
+ additiveValuation unitsKnown canonicalUnitNormal
+ multiplicativeValuation finiteAggregate shallowlyMutable
+ commutative)
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index 723c9593..071059fb 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -398,3 +398,8 @@ $maxSignatureLineNumber := 0
$noSubsumption := false
SPADERRORSTREAM := _*ERROR_-OUTPUT_*
+
+++
+_/VERSION := 0
+_/WSNAME := "NOBOOT"
+
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index 3608e2ad..85f5434f 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -278,6 +278,24 @@
((EQCAR A 'CDR) (LIST 'RPLACD (CADR A) B))
((ERROR 'RPLAC))))))
+(defmacro |rplac| (&rest L)
+ (let (a b s)
+ (cond
+ ((EQCAR (SETQ A (CAR L)) 'ELT)
+ (COND ((AND (INTEGERP (SETQ B (CADDR A))) (>= B 0))
+ (SETQ S "CA")
+ (do ((i 1 (1+ i))) ((> i b)) (SETQ S (STRCONC S "D")))
+ (LIST 'RPLAC (LIST (INTERN (STRCONC S "R")) (CADR A)) (CADR L)))
+ ((ERROR "rplac"))))
+ ((PROGN
+ (SETQ A (CARCDREXPAND (CAR L) NIL))
+ (SETQ B (CADR L))
+ (COND
+ ((CDDR L) (ERROR 'RPLAC))
+ ((EQCAR A 'CAR) (LIST 'RPLACA (CADR A) B))
+ ((EQCAR A 'CDR) (LIST 'RPLACD (CADR A) B))
+ ((ERROR 'RPLAC))))))))
+
;;
;; -*- Association Lists -*-
;;
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-28 11:20:55 +0000