diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 5fc8e56..7e0310f 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -37121,6 +37121,122 @@ database format. nil) \end{chunk} + +\section{Lisp Library Handling} + +\defun{loadLib}{loadLib} +\calls{loadLib}{startTimingProcess} +\calls{loadLib}{getdatabase} +\calls{loadLib}{isSystemDirectory} +\calls{loadLib}{pathnameDirectory} +\calls{loadLib}{loadLibNoUpdate} +\calls{loadLib}{sayKeyedMsg} +\calls{loadLib}{namestring} +\calls{loadLib}{clearConstructorCache} +\calls{loadLib}{updateDatabase} +\calls{loadLib}{installConstructor} +\calls{loadLib}{updateCategoryTable} +\calls{loadLib}{categoryForm?} +\calls{loadLib}{makeprop} +\calls{loadLib}{remprop} +\calls{loadLib}{stopTimingProcess} +\refsdollar{loadLib}{InteractiveMode} +\refsdollar{loadLib}{printLoadMsgs} +\refsdollar{loadLib}{forceDatabaseUpdate} +\defsdollar{loadLib}{CategoryFrame} +\begin{chunk}{defun loadLib} +(defun |loadLib| (cname) + (let (fullLibName systemdir? update? kind u sig coSig) + (declare (special |$CategoryFrame| |$InteractiveMode| |$printLoadMsgs| + |$forceDatabaseUpdate|)) + (|startTimingProcess| '|load|) + (when (setq fullLibName (getdatabase cname 'object)) + (setq systemdir? (|isSystemDirectory| (|pathnameDirectory| fullLibName))) + (setq update? (or |$forceDatabaseUpdate| (null systemdir?))) + (cond + ((null update?) (|loadLibNoUpdate| cname cname fullLibName)) + (t + (setq kind (getdatabase cname 'constructorkind)) + (when |$printLoadMsgs| + (|sayKeyedMsg| 'S2IL0002 (list (|namestring| fullLibName) kind cname))) + (load fullLibName) + (|clearConstructorCache| cname) + (|updateDatabase| cname cname systemdir?) + (|installConstructor| cname kind) + (setq u (getdatabase cname 'constructormodemap)) + (|updateCategoryTable| cname kind) + (setq coSig + (when u + (setq sig (cdar u)) + (cons nil (loop for x in (cdr sig) collect (|categoryForm?| x))))) + (if (null (cdr (getdatabase cname 'constructorform))) + (makeprop cname 'niladic t) + (remprop cname 'niladic)) + (makeprop cname 'loaded fullLibName) + (when |$InteractiveMode| (setq |$CategoryFrame| (list (list nil)))) + (|stopTimingProcess| '|load|) + t))))) + +\end{chunk} + +\defun{isSystemDirectory}{isSystemDirectory} +\calls{isSystemDirectory}{function} +\refsdollar{isSystemDirectory}{spadroot} +\begin{chunk}{defun isSystemDirectory} +(defun |isSystemDirectory| (dir) + (declare (special $spadroot)) + (every (|function| char=) $spadroot dir)) + +\end{chunk} + +\defun{loadLibNoUpdate}{loadLibNoUpdate} +\calls{loadLibNoUpdate}{getdatabase} +\calls{loadLibNoUpdate}{sayKeyedMsg} +\calls{loadLibNoUpdate}{toplevel} +\calls{loadLibNoUpdate}{clearConstructorCache} +\calls{loadLibNoUpdate}{installConstructor} +\calls{loadLibNoUpdate}{makeprop} +\calls{loadLibNoUpdate}{stopTimingProcess} +\refsdollar{loadLibNoUpdate}{printLoadMsgs} +\refsdollar{loadLibNoUpdate}{InteractiveMode} +\defsdollar{loadLibNoUpdate}{CategoryFrame} +\begin{chunk}{defun loadLibNoUpdate} +(defun |loadLibNoUpdate| (cname libName fullLibName) + (declare (ignore libName)) + (let (kind) + (declare (special |$CategoryFrame| |$InteractiveMode| |$printLoadMsgs|)) + (setq kind (getdatabase cname 'constructorkind)) + (when |$printLoadMsgs| + (|sayKeyedMsg| 'S2IL0002 (list (|namestring| fullLibName) kind cname))) + (cond + ((equal (catch 'versioncheck (load fullLibName)) (- 1)) + (princ " wrong library version...recompile ") + (princ fullLibName) + (terpri) + (toplevel)) + (t + (|clearConstructorCache| cname) + (|installConstructor| cname kind) + (makeprop cname 'loaded fullLibName) + (when |$InteractiveMode| (setq |$CategoryFrame| (list (list nil)))) + (|stopTimingProcess| '|load|))) + t)) + +\end{chunk} + +\defun{loadFunctor}{loadFunctor} +\calls{loadFunctor}{loadFunctor} +\calls{loadFunctor}{loadLibIfNotLoaded} +\begin{chunk}{defun loadFunctor} +(defun |loadFunctor| (u) + (cond + ((null (atom u)) (|loadFunctor| (car u))) + (t + (|loadLibIfNotLoaded| u) + u))) + +\end{chunk} + \chapter{Special Lisp Functions} \section{Axiom control structure macros} Axiom used various control structures in the boot code which are not @@ -40322,6 +40438,7 @@ This needs to work off the internal exposure list, not the file. \getchunk{defun isSharpVar} \getchunk{defun isSharpVarWithNum} \getchunk{defun isSubForRedundantMapName} +\getchunk{defun isSystemDirectory} \getchunk{defun isTraceGensym} \getchunk{defun isUncompiledMap} @@ -40345,6 +40462,9 @@ This needs to work off the internal exposure list, not the file. \getchunk{defun listOutputter} \getchunk{defun lnFileName} \getchunk{defun load} +\getchunk{defun loadFunctor} +\getchunk{defun loadLib} +\getchunk{defun loadLibNoUpdate} \getchunk{defun localdatabase} \getchunk{defun localnrlib} \getchunk{defun loopIters2Sex} diff --git a/changelog b/changelog index ccdd3c1..6af8def 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20110715 tpd src/axiom-website/patches.html 20110715.02.tpd.patch +20110715 tpd src/interp/database.lisp treeshake interpreter +20110715 tpd src/interp/lisplib.lisp treeshake interpreter +20110715 tpd books/bookvol5 treeshake interpreter 20110715 tpd src/axiom-website/patches.html 20110715.01.tpd.patch 20110715 tpd src/interp/Makefile add (si::reset-sys-paths) per Camm 20110714 tpd src/axiom-website/patches.html 20110714.01.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 55fafc4..9a730e9 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3544,5 +3544,7 @@ books/bookvol10.3 help and unit tests for RewriteRule
src/interp/axext_l.lisp removed
20110715.01.tpd.patch src/interp/Makefile add (si::reset-sys-paths) per Camm
+20110715.02.tpd.patch +books/bookvol5 treeshake interpreter
diff --git a/src/interp/database.lisp.pamphlet b/src/interp/database.lisp.pamphlet index 3897ebd..3cdd82e 100644 --- a/src/interp/database.lisp.pamphlet +++ b/src/interp/database.lisp.pamphlet @@ -466,6 +466,14 @@ (SEQ (EXIT (|rwrite| |k| (HGET |$depTb| |k|) |stream|)))) (RSHUT |stream|)))))) +;readLib1(fn,ft,fm) == +; -- see if it exists first +; p := pathname [fn,ft,fm] +; readLibPathFast p + +(defun |readLib1| (fn ft fm) + (|readLibPathFast| (|pathname| (list fn ft fm)))) + ;getUsersOfConstructor(con) == ; stream := readLib1('users, 'DATABASE, 'a) ; val := rread(con, stream, nil) diff --git a/src/interp/lisplib.lisp.pamphlet b/src/interp/lisplib.lisp.pamphlet index 4b9de1a..7c66f8a 100644 --- a/src/interp/lisplib.lisp.pamphlet +++ b/src/interp/lisplib.lisp.pamphlet @@ -24,31 +24,6 @@ (DEFUN |isExistingFile| (|f|) (COND ((MAKE-INPUT-FILENAME |f|) 'T) ('T NIL))) -;isSystemDirectory dir == EVERY(function CHAR_=,$SPADROOT,dir) - -(DEFUN |isSystemDirectory| (|dir|) - (declare (special $SPADROOT)) - (EVERY (|function| CHAR=) $SPADROOT |dir|)) - -;--% Standard Library Creation Functions -; -;readLib(fn,ft) == readLib1(fn,ft,"*") - -(DEFUN |readLib| (|fn| |ft|) (|readLib1| |fn| |ft| '*)) - -;readLib1(fn,ft,fm) == -; -- see if it exists first -; p := pathname [fn,ft,fm] -; readLibPathFast p - -(DEFUN |readLib1| (|fn| |ft| |fm|) - (PROG (|p|) - (RETURN - (PROGN - (SPADLET |p| - (|pathname| (CONS |fn| (CONS |ft| (CONS |fm| NIL))))) - (|readLibPathFast| |p|))))) - ;readLibPathFast p == ; -- assumes 1) p is a valid pathname ; -- 2) file has already been checked for existence @@ -57,10 +32,6 @@ (DEFUN |readLibPathFast| (|p|) (RDEFIOSTREAM (CONS (CONS 'FILE |p|) (CONS '(MODE . INPUT) NIL)) NIL)) -;writeLib(fn,ft) == writeLib1(fn,ft,"*") - -(DEFUN |writeLib| (|fn| |ft|) (|writeLib1| |fn| |ft| '*)) - ;writeLib1(fn,ft,fm) == RDEFIOSTREAM [['FILE,fn,ft,fm],'(MODE . OUTPUT)] (DEFUN |writeLib1| (|fn| |ft| |fm|) @@ -68,21 +39,6 @@ (CONS (CONS 'FILE (CONS |fn| (CONS |ft| (CONS |fm| NIL)))) (CONS '(MODE . OUTPUT) NIL)))) -;putFileProperty(fn,ft,id,val) == -; fnStream:= writeLib1(fn,ft,"*") -; val:= rwrite( id,val,fnStream) -; RSHUT fnStream -; val - -(DEFUN |putFileProperty| (|fn| |ft| |id| |val|) - (PROG (|fnStream|) - (RETURN - (PROGN - (SPADLET |fnStream| (|writeLib1| |fn| |ft| '*)) - (SPADLET |val| (|rwrite| |id| |val| |fnStream|)) - (RSHUT |fnStream|) - |val|)))) - ;lisplibWrite(prop,val,filename) == ; -- this may someday not write NIL keys, but it will now ; if $LISPLIB then @@ -117,14 +73,6 @@ (|LAM,FILEACTQ| |key| |form|)) ('T NIL))) -;getLisplib(name,id) == -; -- this version does cache the returned value -; getFileProperty(name,$spadLibFT,id,true) - -(DEFUN |getLisplib| (|name| |id|) - (declare (special |$spadLibFT|)) - (|getFileProperty| |name| |$spadLibFT| |id| 'T)) - ;getLisplibNoCache(name,id) == ; -- this version does not cache the returned value ; getFileProperty(name,$spadLibFT,id,false) @@ -278,146 +226,6 @@ ((GETL |libName| 'LOADED) NIL) ('T (|loadLib| |libName|)))) -;loadLib cname == -; startTimingProcess 'load -; fullLibName := GETDATABASE(cname,'OBJECT) or return nil -; systemdir? := isSystemDirectory(pathnameDirectory fullLibName) -; update? := $forceDatabaseUpdate or not systemdir? -; not update? => -; loadLibNoUpdate(cname, cname, fullLibName) -; kind := GETDATABASE(cname,'CONSTRUCTORKIND) -; if $printLoadMsgs then -; sayKeyedMsg("S2IL0002",[namestring fullLibName,kind,cname]) -; LOAD(fullLibName) -; clearConstructorCache cname -; updateDatabase(cname,cname,systemdir?) -; installConstructor(cname,kind) -; u := GETDATABASE(cname, 'CONSTRUCTORMODEMAP) -; updateCategoryTable(cname,kind) -; coSig := -; u => -; [[.,:sig],:.] := u -; CONS(NIL,[categoryForm?(x) for x in CDR sig]) -; NIL -; -- in following, add property value false or NIL to possibly clear -; -- old value -; if null CDR GETDATABASE(cname,'CONSTRUCTORFORM) then -; MAKEPROP(cname,'NILADIC,'T) -; else -; REMPROP(cname,'NILADIC) -; MAKEPROP(cname,'LOADED,fullLibName) -; if $InteractiveMode then $CategoryFrame := [[nil]] -; stopTimingProcess 'load -; 'T - -(DEFUN |loadLib| (|cname|) - (PROG (|fullLibName| |systemdir?| |update?| |kind| |u| |sig| |coSig|) - (declare (special |$CategoryFrame| |$InteractiveMode| |$printLoadMsgs| - |$forceDatabaseUpdate|)) - (RETURN - (SEQ (PROGN - (|startTimingProcess| '|load|) - (SPADLET |fullLibName| - (OR (GETDATABASE |cname| 'OBJECT) (RETURN NIL))) - (SPADLET |systemdir?| - (|isSystemDirectory| - (|pathnameDirectory| |fullLibName|))) - (SPADLET |update?| - (OR |$forceDatabaseUpdate| (NULL |systemdir?|))) - (COND - ((NULL |update?|) - (|loadLibNoUpdate| |cname| |cname| |fullLibName|)) - ('T - (SPADLET |kind| (GETDATABASE |cname| 'CONSTRUCTORKIND)) - (COND - (|$printLoadMsgs| - (|sayKeyedMsg| 'S2IL0002 - (CONS (|namestring| |fullLibName|) - (CONS |kind| (CONS |cname| NIL)))))) - (LOAD |fullLibName|) (|clearConstructorCache| |cname|) - (|updateDatabase| |cname| |cname| |systemdir?|) - (|installConstructor| |cname| |kind|) - (SPADLET |u| (GETDATABASE |cname| 'CONSTRUCTORMODEMAP)) - (|updateCategoryTable| |cname| |kind|) - (SPADLET |coSig| - (COND - (|u| (SPADLET |sig| (CDAR |u|)) - (CONS NIL - (PROG (G166197) - (SPADLET G166197 NIL) - (RETURN - (DO - ((G166202 (CDR |sig|) - (CDR G166202)) - (|x| NIL)) - ((OR (ATOM G166202) - (PROGN - (SETQ |x| - (CAR G166202)) - NIL)) - (NREVERSE0 G166197)) - (SEQ - (EXIT - (SETQ G166197 - (CONS - (|categoryForm?| |x|) - G166197))))))))) - ('T NIL))) - (COND - ((NULL (CDR (GETDATABASE |cname| 'CONSTRUCTORFORM))) - (MAKEPROP |cname| 'NILADIC 'T)) - ('T (REMPROP |cname| 'NILADIC))) - (MAKEPROP |cname| 'LOADED |fullLibName|) - (COND - (|$InteractiveMode| - (SPADLET |$CategoryFrame| - (CONS (CONS NIL NIL) NIL)))) - (|stopTimingProcess| '|load|) 'T))))))) - -;loadLibNoUpdate(cname, libName, fullLibName) == -; kind := GETDATABASE(cname,'CONSTRUCTORKIND) -; if $printLoadMsgs then -; sayKeyedMsg("S2IL0002",[namestring fullLibName,kind,cname]) -; if CATCH('VERSIONCHECK,LOAD(fullLibName)) = -1 -; then -; PRINC('" wrong library version...recompile ") -; PRINC(fullLibName) -; TERPRI() -; TOPLEVEL() -; else -; clearConstructorCache cname -; installConstructor(cname,kind) -; MAKEPROP(cname,'LOADED,fullLibName) -; if $InteractiveMode then $CategoryFrame := [[nil]] -; stopTimingProcess 'load -; 'T - -(DEFUN |loadLibNoUpdate| (|cname| |libName| |fullLibName|) - (declare (ignore |libName|)) - (PROG (|kind|) - (declare (special |$CategoryFrame| |$InteractiveMode| |$printLoadMsgs|)) - (RETURN - (PROGN - (SPADLET |kind| (GETDATABASE |cname| 'CONSTRUCTORKIND)) - (COND - (|$printLoadMsgs| - (|sayKeyedMsg| 'S2IL0002 - (CONS (|namestring| |fullLibName|) - (CONS |kind| (CONS |cname| NIL)))))) - (COND - ((BOOT-EQUAL (CATCH 'VERSIONCHECK (LOAD |fullLibName|)) - (SPADDIFFERENCE 1)) - (PRINC " wrong library version...recompile ") - (PRINC |fullLibName|) (TERPRI) (TOPLEVEL)) - ('T (|clearConstructorCache| |cname|) - (|installConstructor| |cname| |kind|) - (MAKEPROP |cname| 'LOADED |fullLibName|) - (COND - (|$InteractiveMode| - (SPADLET |$CategoryFrame| (CONS (CONS NIL NIL) NIL)))) - (|stopTimingProcess| '|load|))) - 'T)))) - ;loadIfNecessary u == loadLibIfNecessary(u,true) (DEFUN |loadIfNecessary| (|u|) (|loadLibIfNecessary| |u| 'T)) @@ -591,16 +399,6 @@ (|addModemap| |category| |dc| |sig| |pred| |impl| |$CategoryFrame|))))))) -;loadFunctor u == -; null atom u => loadFunctor first u -; loadLibIfNotLoaded u -; u - -(DEFUN |loadFunctor| (|u|) - (COND - ((NULL (ATOM |u|)) (|loadFunctor| (CAR |u|))) - ('T (|loadLibIfNotLoaded| |u|) |u|))) - ;makeConstructorsAutoLoad() == ; for cnam in allConstructors() repeat ; REMPROP(cnam,'LOADED)