From 154daf2e85eaa209486de6d41e8a1b067590bb8e Mon Sep 17 00:00:00 2001 From: dos-reis Date: Fri, 12 Oct 2007 04:33:34 +0000 Subject: * Makefile.pamphlet (${DEPSYS}): Depend on g-util.$(FASLEXT). Load explicitly. (<>): Remove. (<>): Likewise. (<>): Likewise. (<>): Likewise. (<>): Likewise. (<>): Likewise. (<>): Likewise. (<>): Likewise. (<>): Likewise. (<>): 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. --- src/interp/ChangeLog | 43 +++++++++++ src/interp/Makefile.in | 85 +++++++++++----------- src/interp/Makefile.pamphlet | 146 +++++++++++--------------------------- src/interp/daase.lisp.pamphlet | 9 --- src/interp/g-cndata.boot.pamphlet | 5 +- src/interp/g-opt.boot.pamphlet | 56 +++++++-------- src/interp/g-timer.boot.pamphlet | 4 ++ src/interp/g-util.boot.pamphlet | 1 + src/interp/ht-root.boot.pamphlet | 64 +++++++++-------- src/interp/ht-util.boot.pamphlet | 4 +- src/interp/htcheck.boot.pamphlet | 4 ++ src/interp/htsetvar.boot.pamphlet | 3 + src/interp/hypertex.boot.pamphlet | 25 ++++--- src/interp/profile.boot.pamphlet | 5 +- src/interp/rulesets.boot.pamphlet | 27 +++---- src/interp/setq.lisp.pamphlet | 1 - src/interp/spad.lisp.pamphlet | 20 +----- src/interp/sys-constants.boot | 10 +++ src/interp/sys-globals.boot | 5 ++ src/interp/sys-macros.lisp | 18 +++++ 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,3 +1,46 @@ +2007-10-11 Gabriel Dos Reis + + * Makefile.pamphlet (${DEPSYS}): Depend on g-util.$(FASLEXT). + Load explicitly. + (<>): Remove. + (<>): Likewise. + (<>): Likewise. + (<>): Likewise. + (<>): Likewise. + (<>): Likewise. + (<>): Likewise. + (<>): Likewise. + (<>): Likewise. + (<>): 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 * Makefile.pamphlet (<>): Remove. 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 <> @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.boot - @ echo 237 making $@ from $< - @ echo '(old-boot::boot "profile.boot")' | ${DEPSYS} -@ - \subsection{database.boot \cite{67}} <>= @@ -1265,39 +1256,6 @@ functor.clisp: functor.boot @ echo '(old-boot::boot "functor.boot")' | ${DEPSYS} @ -\subsection{g-cndata.boot} - -<>= -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.boot - @ echo 267 making $@ from $< - @ echo '(old-boot::boot "g-opt.boot")' | ${DEPSYS} -@ - -\subsection{g-timer.boot} - -<>= -g-timer.clisp: g-timer.boot - @ echo 270 making $@ from $< - @ echo '(old-boot::boot "g-timer.boot")' | ${DEPSYS} -@ - - -\subsection{hypertex.boot} - -<>= -hypertex.clisp: hypertex.boot - @ echo 277 making $@ from $< - @ echo '(old-boot::boot "hypertex.boot")' | ${DEPSYS} -@ - \subsection{i-analy.boot} <>= @@ -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.boot - @ echo 388 making $@ from $< - @ echo '(old-boot::boot "rulesets.boot")' | ${DEPSYS} -@ - \subsection{server.boot} <>= @@ -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.boot - @ echo 440 making $@ from $< - @ echo '(old-boot::boot "ht-util.boot")' | ${DEPSYS} -@ - -\subsection{htsetvar.boot} - -<>= -htsetvar.clisp: htsetvar.boot - @ echo 444 making $@ from $< - @ echo '(old-boot::boot "htsetvar.boot")' | ${DEPSYS} -@ - \subsection{record.boot} <>= @@ -1609,22 +1543,6 @@ record.clisp: record.boot @ echo '(old-boot::boot "record.boot")' | ${DEPSYS} @ -\subsection{ht-root.boot} - -<>= -ht-root.clisp: ht-root.boot - @ echo 451 making $@ from $< - @ echo '(old-boot::boot "ht-root.boot")' | ${DEPSYS} -@ - -\subsection{htcheck.boot} - -<>= -htcheck.clisp: htcheck.boot - @ echo 455 making $@ from $< - @ echo '(old-boot::boot "htcheck.boot")' | ${DEPSYS} -@ - \subsection{ax.boot} <>= @@ -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 <> -<> - -<> - -<> - -<> - -<> - -<> - -<> - -<> - <> <> @@ -2038,12 +1978,8 @@ boot-pkg.$(FASLEXT): boot-pkg.lisp <> -<> - <> -<> - <> <> 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 @@ <<*>>= <> +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 @@ <<*>>= <> +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 @@ <<*>>= <> +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 @@ <<*>>= <> +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 @@ <<*>>= <> +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 @@ <<*>>= <> +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 @@ <<*>>= <> +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 @@ <<*>>= <> +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 @@ <<*>>= <> +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 @@ <<*>>= <> +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 @@ <<*>>= <> +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 -*- ;; -- cgit v1.2.3