diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 596a1d4..8070e57 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -5620,6 +5620,12 @@ information is initialized. \end{chunk} +\defvar{localVars} +\begin{chunk}{initvars} +(defvar |$localVars| ()) ;checked by isType + +\end{chunk} + \defun{restart0}{Non-interactive restarts} \calls{restart0}{interpopen} \calls{restart0}{operationopen} @@ -8536,7 +8542,7 @@ and constructs a call to \bfref{Delay}. \defun{theid}{theid} \begin{chunk}{defun theid 0} -(defun |theid| (a) (list identity a)) +(defun |theid| (a) (list #'identity a)) \end{chunk} @@ -18403,8 +18409,7 @@ org prints out the word noposition or console \calls{setMsgCatlessAttr}{ncAlist} \begin{chunk}{defun setMsgCatlessAttr} (defun |setMsgCatlessAttr| (msg attr) - (|ncPutQ| msg '|catless| - (cons attr (ifcdr (qassq |catless| (|ncAlist| msg)))))) + (|ncPutQ| msg catless (cons attr (ifcdr (qassq catless (|ncAlist| msg)))))) \end{chunk} @@ -52690,6 +52695,7 @@ identical. We no longer care so we just call {\tt bcGen}. Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \begin{chunk}{defun stringList2String} (defun |stringList2String| (x) + (let (str) (cond ((null x) "()") (t @@ -52699,7 +52705,7 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| (dolist (i (cdr x) result) (setq result (concatenate 'string result (concatenate 'string "," i))))))) - (concatenate 'string "(" str ")")))) + (concatenate 'string "(" str ")"))))) \end{chunk} @@ -57886,13 +57892,11 @@ There are 8 parts of an htPage: \begin{chunk}{defun kcuPage} (defun |kcuPage| (htPage junk) (declare (ignore junk)) - (let (lt1 kind name args conname constring conform pakname domlist cAlist - conname) + (let (lt1 kind name args constring conform pakname domlist cAlist) (setq lt1 (|htpProperty| htPage '|parts|)) (setq kind (first lt1)) (setq name (second lt1)) (setq args (sixth lt1)) - (setq conname (intern name)) (setq constring (concat name args)) (setq conform (if (nequal kind "default package") @@ -57943,10 +57947,12 @@ There are 8 parts of an htPage: \begin{chunk}{defun kcnPage} (defun |kcnPage| (htPage junk) (declare (ignore junk)) - (let (lt1 kind name nargs domname heading conform pakname domlist cAlist) + (let (lt1 kind name nargs domname heading conform pakname domlist cAlist + conname) (setq lt1 (|htpProperty| htPage '|parts|)) (setq kind (first lt1)) (setq name (second lt1)) + (setq conname (intern name)) (setq nargs (third lt1)) (setq domname (|kDomainName| htPage kind name nargs)) (cond @@ -58011,7 +58017,7 @@ There are 8 parts of an htPage: evaluatedTypeForm) (|htpSetProperty| htPage '|domname| nil) (setq inputAreaList - (loop for i from 1 to nargs for var in |$PatternVariableList| do + (loop for i from 1 to nargs for var in |$PatternVariableList| collect (|htpLabelInputString| htPage var))) (|htpSetProperty| htPage '|inputAreaList| inputAreaList) (setq conname (intern name)) @@ -59431,6 +59437,7 @@ There are 8 parts of an htPage: \begin{chunk}{defun mkConArgSublis} (defun |mkConArgSublis| (args) (loop for arg in args + with s = nil when (and (setq s (pname arg)) diff --git a/changelog b/changelog index baa4a2c..ba77b4f 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,9 @@ +20150103 tpd src/axiom-website/patches.html 20150103.01.tpd.patch +20150103 tpd books/bookvol5 merge, rewrite and remove some browser functions +20150103 tpd src/interp/cattable.lisp merge, rewrite, remove functions +20150103 tpd src/interp/g-util.lisp merge, rewrite, remove functions +20150103 tpd src/interp/lisplib.lisp merge, rewrite, remove functions +20150103 tpd src/interp/patches.lisp merge, rewrite, remove functions 20150102 tpd src/axiom-website/patches.html 20150102.01.tpd.patch 20150102 tpd books/bookvol5 merge, rewrite and remove some browser functions 20150102 tpd src/interp/br-con.lisp remove and rewrite functions diff --git a/patch b/patch index f5a4944..312e54c 100644 --- a/patch +++ b/patch @@ -1,10 +1,10 @@ books/bookvol5 merge, rewrite and remove some browser functions # modified: books/bookvol5.pamphlet -# modified: src/interp/br-con.lisp.pamphlet -# modified: src/interp/interp-proclaims.lisp +# modified: src/interp/cattable.lisp.pamphlet +# modified: src/interp/g-util.lisp.pamphlet # modified: src/interp/lisplib.lisp.pamphlet -# modified: src/interp/nrunfast.lisp.pamphlet -# modified: src/interp/util.lisp.pamphlet +# modified: src/interp/patches.lisp.pamphlet + diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 8a2d305..406593c 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -4888,6 +4888,8 @@ src/input/wester.input absorbed and removed
src/input/wester.input absorbed and removed, yet again
20150102.01.tpd.patch books/bookvol5 merge, rewrite and remove some browser functions
+20150103.01.tpd.patch +books/bookvol5 merge, rewrite and remove some browser functions
diff --git a/src/interp/cattable.lisp.pamphlet b/src/interp/cattable.lisp.pamphlet index 5ba9fa7..242cc71 100644 --- a/src/interp/cattable.lisp.pamphlet +++ b/src/interp/cattable.lisp.pamphlet @@ -216,9 +216,7 @@ (SEQ (EXIT (HPUT *HASCATEGORY-HASH* (CONS |id| |a|) |b|))))))) (|simpTempCategoryTable|) - (|compressHashTable| *ANCESTORS-HASH*) - (|simpCategoryTable|) - (|compressHashTable| *HASCATEGORY-HASH*)))))) + (|simpCategoryTable|)))))) ;simpTempCategoryTable() == ; for id in HKEYS _*ANCESTORS_-HASH_* repeat @@ -1862,30 +1860,6 @@ |res|)))) |res|))))) -;--------------------> NEW DEFINITION (override in patches.lisp.pamphlet) -;compressHashTable ht == -;-- compresses hash table ht, to give maximal sharing of cells -; sayBrightlyNT '"compressing hash table..." -; $found: local := MAKE_-HASHTABLE 'UEQUAL -; for x in HKEYS ht repeat compressSexpr(HGET(ht,x),nil,nil) -; sayBrightly "done" -; ht - -(DEFUN |compressHashTable| (|ht|) - (PROG (|$found|) - (DECLARE (SPECIAL |$found|)) - (RETURN - (SEQ (PROGN - (|sayBrightlyNT| "compressing hash table...") - (SPADLET |$found| (MAKE-HASHTABLE 'UEQUAL)) - (DO ((G167471 (HKEYS |ht|) (CDR G167471)) (|x| NIL)) - ((OR (ATOM G167471) - (PROGN (SETQ |x| (CAR G167471)) NIL)) - NIL) - (SEQ (EXIT (|compressSexpr| (HGET |ht| |x|) NIL NIL)))) - (|sayBrightly| "done") - |ht|))))) - ;compressSexpr(x,left,right) == ;-- recursive version of compressHashTable ; atom x => nil diff --git a/src/interp/g-util.lisp.pamphlet b/src/interp/g-util.lisp.pamphlet index a225d71..a15cc97 100644 --- a/src/interp/g-util.lisp.pamphlet +++ b/src/interp/g-util.lisp.pamphlet @@ -477,47 +477,6 @@ ((ATOM |f|) (CONS |f| (|flattenSexpr| |r|))) ('T (APPEND (|flattenSexpr| |f|) (|flattenSexpr| |r|))))))))) -;isLowerCaseLetter c == charRangeTest CHAR2NUM c - -(DEFUN |isLowerCaseLetter| (|c|) (|charRangeTest| (CHAR2NUM |c|))) - -;isUpperCaseLetter c == charRangeTest QSDIFFERENCE(CHAR2NUM c,64) - -(DEFUN |isUpperCaseLetter| (|c|) - (|charRangeTest| (QSDIFFERENCE (CHAR2NUM |c|) 64))) - -;isLetter c == -; n:= CHAR2NUM c -; charRangeTest n or charRangeTest QSDIFFERENCE(CHAR2NUM c,64) - -(DEFUN |isLetter| (|c|) - (PROG (|n|) - (RETURN - (PROGN - (SPADLET |n| (CHAR2NUM |c|)) - (OR - (|charRangeTest| |n|) - (|charRangeTest| (QSDIFFERENCE (CHAR2NUM |c|) 64))))))) - -;charRangeTest n == -; QSLESSP(153,n) => -; QSLESSP(169,n) => false -; QSLESSP(161,n) => true -; false -; QSLESSP(128,n) => -; QSLESSP(144,n) => true -; QSLESSP(138,n) => false -; true -; false - -(DEFUN |charRangeTest| (|n|) - (COND - ((QSLESSP 153 |n|) - (COND ((QSLESSP 169 |n|) NIL) ((QSLESSP 161 |n|) 'T) ('T NIL))) - ((QSLESSP 128 |n|) - (COND ((QSLESSP 144 |n|) 'T) ((QSLESSP 138 |n|) NIL) ('T 'T))) - ('T NIL))) - ;update() == ; OBEY ; STRCONC('"SPADEDIT ",STRINGIMAGE _/VERSION,'" ",STRINGIMAGE _/WSNAME,'" A") diff --git a/src/interp/lisplib.lisp.pamphlet b/src/interp/lisplib.lisp.pamphlet index 93bba74..99d09e3 100644 --- a/src/interp/lisplib.lisp.pamphlet +++ b/src/interp/lisplib.lisp.pamphlet @@ -275,10 +275,7 @@ (|pathname| |file|)) ((NULL (OR (SPADLET |fileinfo| (FUNLOC |fun|)) (SPADLET |fileinfo| (FUNLOC (|unabbrev| |fun|))))) - (COND - ((SPADLET |u| (|bootFind| |fun|)) - (|getFunctionSourceFile1| (SETQ $FUNCTION (INTERN |u|)))) - ('T NIL))) + nil) ((EQL 3 (|#| |fileinfo|)) (SPADLET |fn| (CAR |fileinfo|)) (SPADLET |ft| (CADR |fileinfo|)) (SPADLET $FUNCTION (CADDR |fileinfo|)) diff --git a/src/interp/patches.lisp.pamphlet b/src/interp/patches.lisp.pamphlet index cc982b6..c7819e0 100644 --- a/src/interp/patches.lisp.pamphlet +++ b/src/interp/patches.lisp.pamphlet @@ -203,11 +203,12 @@ It used to read: (defun |libraryFileLists| () '((SPAD SPADLIBS J))) -;;--------------------> NEW DEFINITION (see cattable.boot.pamphlet) -(defun |compressHashTable| (ht) ht) (defun GETZEROVEC (n) (MAKE-ARRAY n :initial-element 0)) -(defun |normalizeArgFileName| (l) l) +(proclaim '(ftype (function (t) t) identity)) +(defun identity (x) x) +(defvar identity #'identity) ; make LispVM code for handling constants to work + (defun readSpadExpr () (let* ((line (cdar (preparse in-stream)))) @@ -218,17 +219,11 @@ It used to read: (setq |$sourceFiles| ()) ;; set in readSpad2Cmd -(setq |$localVars| ()) ;checked by isType (setq |$highlightFontOn| (concat " " $BOLDSTRING)) (setq |$highlightFontOff| (concat $NORMALSTRING " ")) (define-function 'SUBSTQ #'SUBSTEQ) ;; needed for substNames (always copy) -#+(and :lucid (not :ibm/370)) - (define-function 'RUN-AIX-PROGRAM #'SYS:RUN-AIX-PROGRAM) (setq |$specialCharacters| |$plainRTspecialCharacters|) -;; following should be no longer necessary -;; (eval-when (eval load compile) (shadow 'delete)) -;; (define-function 'boot::delete #'|delete|) ;; following code is to mimic def of MAP in NEWSPAD LISP ;; i.e. MAP in boot package is a self evaluating form @@ -237,117 +232,10 @@ It used to read: (eval-when (eval load compile) (shadow 'map)) (defmacro map (&rest args) `'(map ,@args)) -#+:Lucid -(defun save-system (filename) - (in-package "BOOT") - (UNTRACE) - (|untrace| NIL) - (|clearClams|) - ;; bind output to nulloutstream - (let ((*standard-output* (make-broadcast-stream))) - (|resetWorkspaceVariables|)) - (setq |$specialCharacters| |$plainRTspecialCharacters|) - - (load (make-absolute-filename "lib/interp/obey")) - (system:disksave filename :restart-function restart-hook :full-gc t)) -#+:Lucid (define-function 'user::save-system #'boot::save-system) -(defun |undoINITIALIZE| () ()) -;; following are defined in spadtest.boot and stantest.boot -(defun |installStandardTestPackages| () ()) -(defun |spadtestValueHook| (val type) ()) -(defun |testError| (errotype erroValue) ()) -(defvar |$TestOptions| ()) -;; following in defined in word.boot -(defun |bootFind| (word) ()) -;; following 3 are replacements for g-util.boot -(define-function '|isLowerCaseLetter| #'LOWER-CASE-P) -(define-function '|isUpperCaseLetter| #'UPPER-CASE-P) -(define-function '|isLetter| #'ALPHA-CHAR-P) - (setq vmlisp::$current-directory (make-directory *default-pathname-defaults*)) -#+:AKCL (proclaim '(ftype (function (t) t) identity)) -#+:AKCL (defun identity (x) x) - -(setq identity #'identity) ;to make LispVM code for handling constants to work - (|initializeTimedNames| |$interpreterTimedNames| |$interpreterTimedClasses|) -;buildDatabase(filemode,expensive) == -; $InteractiveMode: local:= true -; $constructorList := nil --looked at by buildLibdb -; $ConstructorCache:= MAKE_-HASHTABLE('ID) -; SAY '"Making constructor autoload" -; makeConstructorsAutoLoad() -; SAY '"Building category table" -; genCategoryTable() -; SAY '"Building libdb.text" -; buildLibdb() -; SAY '"splitting libdb.text" -; dbSplitLibdb() -; SAY '"creating browse constructor index" -; dbAugmentConstructorDataTable() -; SAY '"Building browse.lisp" -; buildBrowsedb() -; SAY '"Building constructor users database" -; mkUsersHashTable() -; SAY '"Saving constructor users database" -; saveUsersHashTable() -; SAY '"Building constructor dependents database" -; mkDependentsHashTable() -; SAY '"Saving constructor dependents database" -; saveDependentsHashTable() -; SAY '"Building glossary files" -; buildGloss() - -;(DEFUN |buildDatabase| (|filemode| |expensive|) -; (declare (ignore |filemode| |expensive|)) -; (PROG (|$InteractiveMode|) -; (DECLARE (SPECIAL |$InteractiveMode| |$ConstructorCache| -; |$constructorList|)) -; (RETURN -; (PROGN -; (SPADLET |$InteractiveMode| 'T) -; (SPADLET |$constructorList| NIL) -; (SPADLET |$ConstructorCache| (MAKE-HASHTABLE 'ID)) -; (SAY "Making constructor autoload") -; (|makeConstructorsAutoLoad|) -; (SAY "Building category table") -; (|genCategoryTable|) -; (SAY "Building libdb.text") -; (|buildLibdb|) -; (SAY "splitting libdb.text") -; (|dbSplitLibdb|) -; (SAY "creating browse constructor index") -; (|dbAugmentConstructorDataTable|) -; (SAY "Building browse.lisp") -; (|buildBrowsedb|) -; (SAY "Building constructor users database") -; (|mkUsersHashTable|) -; (SAY "Saving constructor users database") -; (|saveUsersHashTable|) -; (SAY "Building constructor dependents database") -; (|mkDependentsHashTable|) -; (SAY "Saving constructor dependents database") -; (|saveDependentsHashTable|) -; (SAY "Building glossary files") -; (|buildGloss|))))) -; -;(defun |rebuild| (filemode) -; "rebuild modemap.daase, exit lisp with bad return code on failure" -; (let ((returncode -16)) -; (unwind-protect -; (let (|$databaseQueue| |$e|) -; (declare (special |$databaseQueue| |$e|)) -; (|clearConstructorAndLisplibCaches|) -; (setq |$databaseQueue| nil) -; (setq |$e| (cons (cons nil nil) nil)) -; (|buildDatabase| filemode t) -; (setq |$IOindex| 1) -; (setq |$InteractiveFrame| (cons (cons nil nil) nil)) -; (setq returncode 0)) -; (unless (zerop returncode) (bye returncode))))) - (defun boot::|printCopyright| () (format t "there is no such thing as a simple job -- ((iHy))~%")) @@ -370,41 +258,32 @@ It used to read: ) ) - (defun |makeVector| (els type) (make-array (length els) :element-type (or type t) :initial-contents els)) +(defun |makeList| (size el) + (make-list size :initial-element el) ) -(defun |makeList| (size el) (make-list size :initial-element el) ) +(defun print-xdr-stream (x y z) + (format y "XDR:~A" (xdr-stream-name x))) -#+:akcl -(defun print-xdr-stream (x y z) (format y "XDR:~A" (xdr-stream-name x))) -#+:akcl (defstruct (xdr-stream (:print-function print-xdr-stream)) "A structure to hold XDR streams. The stream is printed out." (handle ) ;; this is what is used for xdr-open xdr-read xdr-write (name )) ;; this is used for printing -#+:akcl -(defun |xdrOpen| (str dir) (make-xdr-stream :handle (system:xdr-open str) :name str)) -#+:CCL -(defun |xdrOpen| (str dir) (xdr-open str dir) ) -#+:dos -(defun |xdrOpen| (str dir) (format t "xdrOpen called")) -#+:akcl -(defun |xdrRead| (xstr r) (system:xdr-read (xdr-stream-handle xstr) r) ) -#+:CCL -(defun |xdrRead| (xstr r) (xdr-read xstr r) ) -#+:dos -(defun |xdrRead| (str) (format t "xdrRead called")) +(defun |xdrOpen| (str dir) + (make-xdr-stream :handle (system:xdr-open str) :name str)) -#+:akcl -(defun |xdrWrite| (xstr d) (system:xdr-write (xdr-stream-handle xstr) d) ) -#+:CCL -(defun |xdrWrite| (xstr d) (xdr-write xstr d) ) -#+:dos -(defun |xdrWrite| (str) (format t "xdrWrite called")) +(defun |xdrOpen| (str dir) + (format t "xdrOpen called")) + +(defun |xdrRead| (xstr r) + (system:xdr-read (xdr-stream-handle xstr) r) ) + +(defun |xdrWrite| (xstr d) + (system:xdr-write (xdr-stream-handle xstr) d) ) ;; here is a test for XDR ;; (setq *print-array* T)