diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 6813080..dfff2b9 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -19727,7 +19727,7 @@ Formal for libdb.text: \calls{buildLibdbString}{stringimage} \begin{chunk}{defun buildLibdbString} (defun |buildLibdbString| (arg) - (let (x u (result "")) + (let (x u) (setq x (car arg)) (setq u (cdr arg)) (strconc (stringimage x) @@ -19809,8 +19809,7 @@ Formal for libdb.text: \defsdollar{buildLibdbConEntry}{conname} \begin{chunk}{defun buildLibdbConEntry} (defun |buildLibdbConEntry| (conname) - (let (abb conform pname tmp3 z kind argl tmp1 tmp2 r conComments argpart - sigpart header) + (let (abb conform pname kind argl tmp1 conComments argpart sigpart header) (declare (special |$exposed?| |$doc| |$kind| |$conname| |$conform|)) (cond ((null (getdatabase conname 'constructormodemap)) nil) @@ -19862,6 +19861,126 @@ Formal for libdb.text: \end{chunk} +\defun{buildLibOps}{buildLibOps} +\calls{buildLibOps}{buildLibOp} +\begin{chunk}{defun buildLibOps} +(defun |buildLibOps| (oplist) + (loop for item in oplist + do (|buildLibOp| (car item) (cadr item) (cddr item)))) + +\end{chunk} + +\defun{buildLibOp}{buildLibOp} +\calls{buildLibOp}{sublislis} +\calls{buildLibOp}{msubst} +\calls{buildLibOp}{form2LispString} +\calls{buildLibOp}{stringimage} +\calls{buildLibOp}{strconc} +\calls{buildLibOp}{libdbTrim} +\calls{buildLibOp}{concatWithBlanks} +\calls{buildLibOp}{lassoc} +\calls{buildLibOp}{checkCommentsForBraces} +\calls{buildLibOp}{writedb} +\calls{buildLibOp}{buildLibdbString} +\refsdollar{buildLibOp}{kind} +\refsdollar{buildLibOp}{doc} +\refsdollar{buildLibOp}{exposed?} +\refsdollar{buildLibOp}{conform} +\begin{chunk}{defun buildLibOp} +(defun |buildLibOp| (op sig pred) + (let (nsig sigpart predString s sop header conform comments) + (declare (special |$kind| |$doc| |$exposed?| |$conform|)) + (setq nsig (sublislis (cdr |$conform|) |$FormalMapVariableList| sig)) + (setq pred (sublislis (cdr |$conform|) |$FormalMapVariableList| pred)) + (setq nsig (msubst 't 't$ nsig)) + (setq pred (msubst 't 't$ pred)) + (setq sigpart (|form2LispString| (cons '|Mapping| nsig))) + (setq predString (if (eq pred t) "" (|form2LispString| pred))) + (setq sop + (cond + ((string= (setq s (stringimage op)) "One") "1") + ((string= s "Zero") "0") + (t s))) + (setq header (strconc "o" sop)) + (setq conform (strconc |$kind| (|form2LispString| |$conform|))) + (setq comments + (|libdbTrim| (|concatWithBlanks| (lassoc sig (lassoc op |$doc|))))) + (|checkCommentsForBraces| '|operation| sop sigpart comments) + (|writedb| + (|buildLibdbString| + (list header (|#| (cdr sig)) |$exposed?| sigpart + conform predString comments))))) + +\end{chunk} + +\defun{buildLibAttrs}{buildLibAttrs} +\calls{buildLibAttrs}{buildLibAttr} +\begin{chunk}{defun buildLibAttrs} +(defun |buildLibAttrs| (attrlist) + (let (name argl pred) + (loop for item in attrlist + do (|buildLibAttr| (car item) (cadr item) (cddr item))))) + +\end{chunk} + +\defun{buildLibAttr}{buildLibAttr} +\begin{verbatim} + attributes AKname\#\args\conname\pred\comments (K is U or C) +\end{verbatim} +\calls{buildLibAttr}{stringimage} +\calls{buildLibAttr}{form2LispString} +\calls{buildLibAttr}{sublislis} +\calls{buildLibAttr}{concatWithBlanks} +\calls{buildLibAttr}{lassoc} +\calls{buildLibAttr}{checkCommentsForBraces} +\calls{buildLibAttr}{writedb} +\calls{buildLibAttr}{buildLibdbString} +\calls{buildLibAttr}{length} +\refsdollar{buildLibAttr}{conform} +\refsdollar{buildLibAttr}{FormalMapVariableList} +\refsdollar{buildLibAttr}{kind} +\refsdollar{buildLibAttr}{doc} +\refsdollar{buildLibAttr}{exposed?} +\refsdollar{buildLibAttr}{conname} +\begin{chunk}{defun buildLibAttr} +(defun |buildLibAttr| (name argl pred) + (let (argPart predString header conname comments) + (declare (special |$kind| |$conname| |$doc| |$conform| + |$FormalMapVariableList| |$exposed?|)) + (setq header (strconc "a" (stringimage name))) + (setq argPart (substring (|form2LispString| (cons '|f| argl)) 1 nil)) + (setq pred (sublislis (cdr |$conform|) |$FormalMapVariableList| pred)) + (setq predString (if (eq pred t) "" (|form2LispString| pred))) + (setq header (strconc "a" (stringimage name))) + (setq conname (strconc |$kind| (|form2LispString| |$conname|))) + (setq comments + (|concatWithBlanks| (lassoc (cons '|attribute| argl) (lassoc name |$doc|)))) + (|checkCommentsForBraces| '|attribute| (stringimage name) argl comments) + (|writedb| + (|buildLibdbString| + (list header (|#| argl) |$exposed?| argPart + conname predString comments))))) + +\end{chunk} + +\defun{screenLocalLine}{screenLocalLine} +\calls{screenLocalLine}{dbPart} +\calls{screenLocalLine}{charPosition} +\calls{screenLocalLine}{dbName} +\calls{screenLocalLine}{dbKind} +\begin{chunk}{defun screenLocalLine} +(defun |screenLocalLine| (line conlist) + (let (s k con) + (setq k (|dbKind| line)) + (setq con + (intern (cond ((or (char= k #\o) (char= k #\a)) + (setq s (|dbPart| line 5 1)) + (setq k (|charPosition| #\( s 1)) + (substring s 1 (1- k))) + (t (|dbName| line))))) + (member con conlist))) + +\end{chunk} \chapter{Comment Syntax Checking} @@ -26216,9 +26335,13 @@ The current input line. \getchunk{defun blankp} \getchunk{defun bootStrapError} +\getchunk{defun buildLibAttr} +\getchunk{defun buildLibAttrs} \getchunk{defun buildLibdb} \getchunk{defun buildLibdbConEntry} \getchunk{defun buildLibdbString} +\getchunk{defun buildLibOp} +\getchunk{defun buildLibOps} \getchunk{defun bumperrorcount} \getchunk{defun canReturn} @@ -26832,6 +26955,7 @@ The current input line. \getchunk{defun /RQ,LIB} \getchunk{defun rwriteLispForm} +\getchunk{defun screenLocalLine} \getchunk{defun setDefOp} \getchunk{defun seteltModemapFilter} \getchunk{defun setqMultiple} diff --git a/changelog b/changelog index f4efa46..1fa19a3 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20120102 tpd src/axiom-website/patches.html 20120102.01.tpd.patch +20120101 tpd src/interp/br-con.lisp treeshake compiler +20120101 tpd books/bookvol9 treeshake compiler 20120101 tpd src/axiom-website/patches.html 20120101.03.tpd.patch 20120101 tpd src/interp/cattable.lisp treeshake compiler 20120101 tpd books/bookvol9 treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 081cd71..86c2806 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3759,5 +3759,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20120101.03.tpd.patch books/bookvol9 treeshake compiler
+20120102.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/br-con.lisp.pamphlet b/src/interp/br-con.lisp.pamphlet index 77c02ff..009697a 100644 --- a/src/interp/br-con.lisp.pamphlet +++ b/src/interp/br-con.lisp.pamphlet @@ -4729,91 +4729,6 @@ |n|))) ('T |s|))) -;buildLibOps oplist == for [op,sig,:pred] in oplist repeat buildLibOp(op,sig,pred) - -(DEFUN |buildLibOps| (|oplist|) - (PROG (|op| |sig| |pred|) - (declare (special |$kind| |$doc| |$exposed?|)) - (RETURN - (SEQ (DO ((G168379 |oplist| (CDR G168379)) (G168370 NIL)) - ((OR (ATOM G168379) - (PROGN (SETQ G168370 (CAR G168379)) NIL) - (PROGN - (PROGN - (SPADLET |op| (CAR G168370)) - (SPADLET |sig| (CADR G168370)) - (SPADLET |pred| (CDDR G168370)) - G168370) - NIL)) - NIL) - (SEQ (EXIT (|buildLibOp| |op| |sig| |pred|)))))))) - -;buildLibOp(op,sig,pred) == -;--operations OKop \#\sig \conname\pred\comments (K is U or C) -; nsig := SUBLISLIS(rest $conform,$FormalMapVariableList,sig) -; pred := SUBLISLIS(rest $conform,$FormalMapVariableList,pred) -; nsig := SUBST('T,"T$",nsig) --this ancient artifact causes troubles! -; pred := SUBST('T,"T$",pred) -; sigpart:= form2LispString ['Mapping,:nsig] -; predString := (pred = 'T => '""; form2LispString pred) -; sop := -; (s := STRINGIMAGE op) = '"One" => '"1" -; s = '"Zero" => '"0" -; s -; header := STRCONC('"o",sop) -; conform:= STRCONC($kind,form2LispString $conform) -; comments:= libdbTrim concatWithBlanks LASSOC(sig,LASSOC(op,$doc)) -; checkCommentsForBraces('operation,sop,sigpart,comments) -; writedb -; buildLibdbString [header,# rest sig,$exposed?,sigpart,conform,predString,comments] - -(DEFUN |buildLibOp| (|op| |sig| |pred|) - (PROG (|nsig| |sigpart| |predString| |s| |sop| |header| |conform| - |comments|) - (declare (special |$kind| |$doc| |$exposed?| |$conform|)) - (RETURN - (PROGN - (SPADLET |nsig| - (SUBLISLIS (CDR |$conform|) |$FormalMapVariableList| - |sig|)) - (SPADLET |pred| - (SUBLISLIS (CDR |$conform|) |$FormalMapVariableList| - |pred|)) - (SPADLET |nsig| (MSUBST 'T 'T$ |nsig|)) - (SPADLET |pred| (MSUBST 'T 'T$ |pred|)) - (SPADLET |sigpart| - (|form2LispString| (CONS '|Mapping| |nsig|))) - (SPADLET |predString| - (COND - ((BOOT-EQUAL |pred| 'T) "") - ('T (|form2LispString| |pred|)))) - (SPADLET |sop| - (COND - ((BOOT-EQUAL (SPADLET |s| (STRINGIMAGE |op|)) - "One") - "1") - ((BOOT-EQUAL |s| "Zero") - "0") - ('T |s|))) - (SPADLET |header| (STRCONC "o" |sop|)) - (SPADLET |conform| - (STRCONC |$kind| (|form2LispString| |$conform|))) - (SPADLET |comments| - (|libdbTrim| - (|concatWithBlanks| - (LASSOC |sig| (LASSOC |op| |$doc|))))) - (|checkCommentsForBraces| '|operation| |sop| |sigpart| - |comments|) - (|writedb| - (|buildLibdbString| - (CONS |header| - (CONS (|#| (CDR |sig|)) - (CONS |$exposed?| - (CONS |sigpart| - (CONS |conform| - (CONS |predString| - (CONS |comments| NIL))))))))))))) - ;libdbTrim s == ; k := MAXINDEX s ; k < 0 => s @@ -4906,76 +4821,6 @@ (|pp| |comments|)) ('T NIL))))))) -;buildLibAttrs attrlist == -; for [name,argl,:pred] in attrlist repeat buildLibAttr(name,argl,pred) - -(DEFUN |buildLibAttrs| (|attrlist|) - (PROG (|name| |argl| |pred|) - (RETURN - (SEQ (DO ((G168452 |attrlist| (CDR G168452)) (G168443 NIL)) - ((OR (ATOM G168452) - (PROGN (SETQ G168443 (CAR G168452)) NIL) - (PROGN - (PROGN - (SPADLET |name| (CAR G168443)) - (SPADLET |argl| (CADR G168443)) - (SPADLET |pred| (CDDR G168443)) - G168443) - NIL)) - NIL) - (SEQ (EXIT (|buildLibAttr| |name| |argl| |pred|)))))))) - -;buildLibAttr(name,argl,pred) == -;--attributes AKname\#\args\conname\pred\comments (K is U or C) -; header := STRCONC('"a",STRINGIMAGE name) -; argPart:= SUBSTRING(form2LispString ['f,:argl],1,nil) -; pred := SUBLISLIS(rest $conform,$FormalMapVariableList,pred) -; predString := (pred = 'T => '""; form2LispString pred) -; header := STRCONC('"a",STRINGIMAGE name) -; conname := STRCONC($kind,form2LispString $conname) -; comments:= concatWithBlanks LASSOC(['attribute,:argl],LASSOC(name,$doc)) -; checkCommentsForBraces('attribute,STRINGIMAGE name,argl,comments) -; writedb -; buildLibdbString [header,# argl,$exposed?,argPart,conname,predString,comments] - -(DEFUN |buildLibAttr| (|name| |argl| |pred|) - (PROG (|argPart| |predString| |header| |conname| |comments|) - (declare (special |$kind| |$conname| |$doc| |$conform| - |$FormalMapVariableList| |$exposed?|)) - (RETURN - (PROGN - (SPADLET |header| - (STRCONC "a" (STRINGIMAGE |name|))) - (SPADLET |argPart| - (SUBSTRING (|form2LispString| (CONS '|f| |argl|)) 1 - NIL)) - (SPADLET |pred| - (SUBLISLIS (CDR |$conform|) |$FormalMapVariableList| - |pred|)) - (SPADLET |predString| - (COND - ((BOOT-EQUAL |pred| 'T) "") - ('T (|form2LispString| |pred|)))) - (SPADLET |header| - (STRCONC "a" (STRINGIMAGE |name|))) - (SPADLET |conname| - (STRCONC |$kind| (|form2LispString| |$conname|))) - (SPADLET |comments| - (|concatWithBlanks| - (LASSOC (CONS '|attribute| |argl|) - (LASSOC |name| |$doc|)))) - (|checkCommentsForBraces| '|attribute| (STRINGIMAGE |name|) - |argl| |comments|) - (|writedb| - (|buildLibdbString| - (CONS |header| - (CONS (|#| |argl|) - (CONS |$exposed?| - (CONS |argPart| - (CONS |conname| - (CONS |predString| - (CONS |comments| NIL))))))))))))) - ;dbAugmentConstructorDataTable() == ; instream := MAKE_-INSTREAM '"libdb.text" ; while not EOFP instream repeat @@ -26797,40 +26642,6 @@ $dbKindAlist := ;--======================================================================= ;-- Code for Private Libdbs ;--======================================================================= -;-- Got rid of debugging statement and deleted screenLocalLine1, MCD 26/3/96 -;--screenLocalLine(line,conlist) == -;-- u := screenLocalLine1(line,conlist) -;-- if u then -;-- sayBrightly ['"Purging--->", line] -;-- u -;-- screenLocalLine1(line, conlist) == -;screenLocalLine(line, conlist) == -; k := dbKind line -; con := INTERN -; k = char 'o or k = char 'a => -; s := dbPart(line,5,1) -; k := charPosition(char '_(,s,1) -; SUBSTRING(s,1,k - 1) -; dbName line -; MEMQ(con, conlist) - -(DEFUN |screenLocalLine| (|line| |conlist|) - (PROG (|s| |k| |con|) - (RETURN - (PROGN - (SPADLET |k| (|dbKind| |line|)) - (SPADLET |con| - (INTERN (COND - ((OR (BOOT-EQUAL |k| (|char| '|o|)) - (BOOT-EQUAL |k| (|char| '|a|))) - (SPADLET |s| (|dbPart| |line| 5 1)) - (SPADLET |k| - (|charPosition| (|char| '|(|) |s| - 1)) - (SUBSTRING |s| 1 (SPADDIFFERENCE |k| 1))) - ('T (|dbName| |line|))))) - (member |con| |conlist|))))) - ;--------------> NEW DEFINITION (see br-data.boot.pamphlet) ;purgeLocalLibdb() == --called by the user through a clear command? ; $newConstructorList := nil