* 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.
author: dos-reis <gdr@axiomatics.org> 2007-10-12 04:33:34 +0000
committer: dos-reis <gdr@axiomatics.org> 2007-10-12 04:33:34 +0000
commit: 154daf2e85eaa209486de6d41e8a1b067590bb8e (patch)
tree: 66b48e2b838cd2033727638c181a12d21b7e4ead
parent: bdea50f2baa8f866a77d355ef23a1ba844f8c2b7 (diff)
download: open-axiom-154daf2e85eaa209486de6d41e8a1b067590bb8e.tar.gz
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 -*-
 ;;
author	dos-reis <gdr@axiomatics.org>	2007-10-12 04:33:34 +0000
committer	dos-reis <gdr@axiomatics.org>	2007-10-12 04:33:34 +0000
commit	154daf2e85eaa209486de6d41e8a1b067590bb8e (patch)
tree	66b48e2b838cd2033727638c181a12d21b7e4ead
parent	bdea50f2baa8f866a77d355ef23a1ba844f8c2b7 (diff)
download	open-axiom-154daf2e85eaa209486de6d41e8a1b067590bb8e.tar.gz