diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 88813ed..cfd3113 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -52475,6 +52475,147 @@ There are 8 parts of an htPage: \end{chunk} +\defun{dbShowConsDoc}{dbShowConsDoc} +\calls{dbShowConsDoc}{systemError} +\calls{dbShowConsDoc}{dbShowConsDoc1} +\calls{dbShowConsDoc}{getConstructorForm} +\calls{dbShowConsDoc}{opOf} +\calls{dbShowConsDoc}{htpProperty} +\calls{dbShowConsDoc}{remdup} +\begin{chunk}{defun dbShowConsDoc} +(defun |dbShowConsDoc| (htPage conlist) + (labels ( + (fn (cAlist x) + (let ((index 0)) + (loop while (not (equal (caaar cAlist) x)) + do (setq index (1+ index)) + (setq cAlist (cdr cAlist)) + (unless cAlist (|systemError|))) + index))) + (let (index cAlist) + (cond + ((null (cdr conlist)) + (|dbShowConsDoc1| htPage + (|getConstructorForm| (|opOf| (car conlist))) nil)) + (t + (setq cAlist (|htpProperty| htPage '|cAlist|)) + (loop for x in (remdup conlist) do + (|dbShowConsDoc1| htPage + (|getConstructorForm| x) (fn cAlist x)))))))) + +\end{chunk} + +\defun{dbShowConsDoc1}{dbShowConsDoc1} +\calls{dbShowConsDoc1}{member} +\calls{dbShowConsDoc1}{htpProperty} +\calls{dbShowConsDoc1}{getl} +\calls{dbShowConsDoc1}{displayDomainOp} +\calls{dbShowConsDoc1}{isExposedConstructor} +\calls{dbShowConsDoc1}{getConstructorDocumentation} +\calls{dbShowConsDoc1}{getConstructorSignature} +\calls{dbShowConsDoc1}{getdatabase} +\calls{dbShowConsDoc1}{sublislis} +\calls{dbShowConsDoc1}{sublisFormal} +\calls{dbShowConsDoc1}{htSaySaturn} +\calls{dbShowConsDoc1}{displayDomainOp} +\calls{dbShowConsDoc1}{htSaySaturn} +\usesdollar{dbShowConsDoc1}{TriangleVariableList} +\usesdollar{dbShowConsDoc1}{Primitives} +\begin{chunk}{defun dbShowConsDoc1} +(defun |dbShowConsDoc1| (htPage conform indexOrNil) + (let (conargs conname lt1 exposeFlag doc signature sig) + (declare (special |$TriangleVariableList| |$Primitives|)) + (setq conname (car conform)) + (setq conargs (cdr conform)) + (cond + ((member conname |$Primitives|) + (setq conname (|htpProperty| htPage '|conname|)) + (setq lt1 (getl conname '|documentation|)) + (cond ((eq (caar lt1) '|constructor|) (caar lt1))) + (cond ((eq (caadar lt1) 'nil) (caadar lt1))) + (setq doc (car (cdadar lt1))) + (setq sig '((category domain) (|SetCategory|) (|SetCategory|))) + (|displayDomainOp| htPage "constructor" + conform conname sig t doc indexOrNil '|dbSelectCon| nil nil)) + (t + (setq exposeFlag (|isExposedConstructor| conname)) + (setq doc (list (|getConstructorDocumentation| conname))) + (setq signature (|getConstructorSignature| conname)) + (setq sig + (if (eq (getdatabase conname 'constructorkind) '|category|) + (sublislis conargs |$TriangleVariableList| signature) + (|sublisFormal| conargs signature))) + (|htSaySaturn| "\\begin{description}") + (|displayDomainOp| htPage "constructor" conform conname sig t doc + indexOrNil '|dbSelectCon| (null exposeFlag) nil) + (|htSaySaturn| "\\end{description}"))))) + +\end{chunk} + +\defun{getConstructorDocumentation}{getConstructorDocumentation} +\calls{getConstructorDocumentation}{lassoc} +\calls{getConstructorDocumentation}{getdatabase} +\calls{getConstructorDocumentation}{qcar} +\calls{getConstructorDocumentation}{qcaar} +\calls{getConstructorDocumentation}{qcdar} +\calls{getConstructorDocumentation}{qcadar} +\begin{chunk}{defun getConstructorDocumentation} +(defun |getConstructorDocumentation| (conname) + (let (IT1) + (setq IT1 (lassoc '|constructor| (getdatabase conname 'documentation))) + (or + (and (consp IT1) (consp (qcar IT1)) (null (qcaar IT1)) (consp (qcdar IT1)) + (qcadar IT1)) + ""))) + +\end{chunk} + +\defun{dbSelectCon}{dbSelectCon} +\calls{dbSelectCon}{conPage} +\calls{dbSelectCon}{opOf} +\calls{dbSelectCon}{htpProperty} +\begin{chunk}{defun dbSelectCon} +(defun |dbSelectCon| (htPage which index) + (declare (ignore which)) + (|conPage| (|opOf| (car (elt (|htpProperty| htPage '|cAlist|) index))))) + +\end{chunk} + +\defun{dbShowConditions}{dbShowConditions} +\calls{dbShowConditions}{htpProperty} +\calls{dbShowConditions}{opOf} +\calls{dbShowConditions}{splitConTable} +\calls{dbShowConditions}{pluralize} +\calls{dbShowConditions}{stringimage} +\calls{dbShowConditions}{length} +\calls{dbShowConditions}{dbSayItems} +\calls{dbShowConditions}{htSaySaturn} +\calls{dbShowConditions}{bcConPredTable} +\calls{dbShowConditions}{htSayHrule} +\calls{dbShowConditions}{dbSayItems} +\begin{chunk}{defun dbShowConditions} +(defun |dbShowConditions| (htPage cAlist kind) + (let (conform conname article whichever lt1 consNoPred consPred singular + plural) + (setq conform (|htpProperty| htPage '|conform|)) + (setq conname (|opOf| conform)) + (setq article (|htpProperty| htPage '|article|)) + (setq whichever (|htpProperty| htPage '|whichever|)) + (setq lt1 (|splitConTable| cAlist)) + (setq consNoPred (car lt1)) + (setq consPred (cdr lt1)) + (setq singular (list kind " is")) + (setq plural (list (|pluralize| (stringimage kind)) " are")) + (|dbSayItems| (|#| consNoPred) singular plural " unconditional") + (|htSaySaturn| "\\\\") + (|bcConPredTable| consNoPred conname) + (|htSayHrule|) + (|dbSayItems| (|#| consPred) singular plural " conditional") + (|htSaySaturn| "\\\\") + (|bcConPredTable| consPred conname))))) + +\end{chunk} + \chapter{The Interpreter} \begin{chunk}{Interpreter} (setq *print-array* nil) @@ -53089,8 +53230,12 @@ There are 8 parts of an htPage: \getchunk{defun dbGetDocTable,hn} \getchunk{defun dbNonEmptyPattern} \getchunk{defun dbSearchOrder} +\getchunk{defun dbSelectCon} +\getchunk{defun dbShowConditions} \getchunk{defun dbShowCons} \getchunk{defun dbShowCons1} +\getchunk{defun dbShowConsDoc} +\getchunk{defun dbShowConsDoc1} \getchunk{defun dbShowConsKindsFilter} \getchunk{defun dbSubConform} \getchunk{defun decideHowMuch} @@ -53205,6 +53350,7 @@ There are 8 parts of an htPage: \getchunk{defun getAndSay} \getchunk{defun getBpiNameIfTracedMap} \getchunk{defun getBrowseDatabase} +\getchunk{defun getConstructorDocumentation} \getchunk{defun getdatabase} \getchunk{defun getDependentsOfConstructor} \getchunk{defun getDirectoryList} diff --git a/changelog b/changelog index 50e5235..d9b8385 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20130622 tpd src/axiom-website/patches.html 20130622.01.tpd.patch +20130622 tpd src/interp/br-con.lisp move code to bookvol5 +20130622 tpd books/bookvol5 move code from br-con.lisp 20130621 tpd src/axiom-website/patches.html 20130621.01.tpd.patch 20130621 tpd src/interp/br-con.lisp move code to bookvol5 20130621 tpd books/bookvol5 move code from br-con.lisp diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index ea71e73..c806b54 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -4214,6 +4214,8 @@ books/bookvol5 move code from br-con.lisp books/bookvol5 move code from br-con.lisp 20130621.01.tpd.patch books/bookvol5 move code from br-con.lisp +20130622.01.tpd.patch +books/bookvol5 move code from br-con.lisp diff --git a/src/interp/br-con.lisp.pamphlet b/src/interp/br-con.lisp.pamphlet index 7bbc6f7..35429a8 100644 --- a/src/interp/br-con.lisp.pamphlet +++ b/src/interp/br-con.lisp.pamphlet @@ -12,189 +12,6 @@ \begin{chunk}{*} (IN-PACKAGE "BOOT" ) -;dbShowConsDoc(htPage,conlist) == -; null rest conlist => dbShowConsDoc1(htPage,getConstructorForm opOf first conlist,nil) -; cAlist := htpProperty(htPage,'cAlist) -; --the following code is necessary to skip over duplicates on cAlist -; index := 0 -; for x in REMDUP conlist repeat -; -- for x in conlist repeat -; dbShowConsDoc1(htPage,getConstructorForm x,i) where i == -; while CAAAR cAlist ^= x repeat -; index := index + 1 -; cAlist := rest cAlist -; null cAlist => systemError () -; index - -(DEFUN |dbShowConsDoc| (|htPage| |conlist|) - (PROG (|index| |cAlist|) - (RETURN - (SEQ (COND - ((NULL (CDR |conlist|)) - (|dbShowConsDoc1| |htPage| - (|getConstructorForm| (|opOf| (CAR |conlist|))) NIL)) - ('T (SPADLET |cAlist| (|htpProperty| |htPage| '|cAlist|)) - (SPADLET |index| 0) - (DO ((G167706 (REMDUP |conlist|) (CDR G167706)) - (|x| NIL)) - ((OR (ATOM G167706) - (PROGN (SETQ |x| (CAR G167706)) NIL)) - NIL) - (SEQ (EXIT (|dbShowConsDoc1| |htPage| - (|getConstructorForm| |x|) - (PROGN - (DO () - ((NULL - (NEQUAL (CAAAR |cAlist|) |x|)) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |index| - (PLUS |index| 1)) - (SPADLET |cAlist| - (CDR |cAlist|)) - (COND - ((NULL |cAlist|) - (|systemError|))))))) - |index|))))))))))) - -;dbShowConsDoc1(htPage,conform,indexOrNil) == -; [conname,:conargs] := conform -; MEMQ(conname,$Primitives) => -; conname := htpProperty(htPage,'conname) -; [["constructor",["NIL",doc]],:.] := GET(conname,'documentation) -; sig := '((CATEGORY domain) (SetCategory) (SetCategory)) -; displayDomainOp(htPage,'"constructor",conform,conname,sig,true,doc,indexOrNil,'dbSelectCon,nil,nil) -; exposeFlag := isExposedConstructor conname -; doc := [getConstructorDocumentation conname] -; signature := getConstructorSignature conname -; sig := -; GETDATABASE(conname,'CONSTRUCTORKIND) = 'category => -; SUBLISLIS(conargs,$TriangleVariableList,signature) -; sublisFormal(conargs,signature) -; htSaySaturn '"\begin{description}" -; displayDomainOp(htPage,'"constructor",conform,conname,sig,true,doc,indexOrNil,'dbSelectCon,null exposeFlag,nil) -; htSaySaturn '"\end{description}" - -(DEFUN |dbShowConsDoc1| (|htPage| |conform| |indexOrNil|) - (PROG (|conargs| |conname| |LETTMP#1| |exposeFlag| |doc| |signature| - |sig|) - (declare (special |$TriangleVariableList| |$Primitives|)) - (RETURN - (PROGN - (SPADLET |conname| (CAR |conform|)) - (SPADLET |conargs| (CDR |conform|)) - (COND - ((member |conname| |$Primitives|) - (SPADLET |conname| (|htpProperty| |htPage| '|conname|)) - (SPADLET |LETTMP#1| (GETL |conname| '|documentation|)) - (COND - ((EQ (CAAR |LETTMP#1|) '|constructor|) (CAAR |LETTMP#1|))) - (COND ((EQ (CAADAR |LETTMP#1|) 'NIL) (CAADAR |LETTMP#1|))) - (SPADLET |doc| (CAR (CDADAR |LETTMP#1|))) - (SPADLET |sig| - '((CATEGORY |domain|) (|SetCategory|) - (|SetCategory|))) - (|displayDomainOp| |htPage| "constructor" - |conform| |conname| |sig| 'T |doc| |indexOrNil| - '|dbSelectCon| NIL NIL)) - ('T (SPADLET |exposeFlag| (|isExposedConstructor| |conname|)) - (SPADLET |doc| - (CONS (|getConstructorDocumentation| |conname|) - NIL)) - (SPADLET |signature| (|getConstructorSignature| |conname|)) - (SPADLET |sig| - (COND - ((BOOT-EQUAL - (GETDATABASE |conname| 'CONSTRUCTORKIND) - '|category|) - (SUBLISLIS |conargs| |$TriangleVariableList| - |signature|)) - ('T (|sublisFormal| |conargs| |signature|)))) - (|htSaySaturn| "\\begin{description}") - (|displayDomainOp| |htPage| "constructor" - |conform| |conname| |sig| 'T |doc| |indexOrNil| - '|dbSelectCon| (NULL |exposeFlag|) NIL) - (|htSaySaturn| "\\end{description}"))))))) - -; --NOTE that we pass conform is as "origin" -;getConstructorDocumentation conname == -; LASSOC('constructor,GETDATABASE(conname,'DOCUMENTATION)) -; is [[nil,line,:.],:.] and line or '"" - -(DEFUN |getConstructorDocumentation| (|conname|) - (PROG (|ISTMP#1| |ISTMP#2| |ISTMP#3| |line|) - (RETURN - (OR (AND (PROGN - (SPADLET |ISTMP#1| - (LASSOC '|constructor| - (GETDATABASE |conname| - 'DOCUMENTATION))) - (AND (CONSP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (NULL (QCAR |ISTMP#2|)) - (PROGN - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND (CONSP |ISTMP#3|) - (PROGN - (SPADLET |line| (QCAR |ISTMP#3|)) - 'T))))))) - |line|) - "")))) - -;dbSelectCon(htPage,which,index) == -; conPage opOf first htpProperty(htPage,'cAlist) . index - -(DEFUN |dbSelectCon| (|htPage| |which| |index|) - (declare (ignore |which|)) - (|conPage| - (|opOf| (CAR (ELT (|htpProperty| |htPage| '|cAlist|) |index|))))) - -;dbShowConditions(htPage,cAlist,kind) == -; conform := htpProperty(htPage,'conform) -; conname := opOf conform -; article := htpProperty(htPage,'article) -; whichever := htpProperty(htPage,'whichever) -; [consNoPred,:consPred] := splitConTable cAlist -; singular := [kind,'" is"] -; plural := [pluralize STRINGIMAGE kind,'" are"] -; dbSayItems(#consNoPred,singular,plural,'" unconditional") -; htSaySaturn '"\\" -; bcConPredTable(consNoPred,conname) -; htSayHrule() -; dbSayItems(#consPred,singular,plural,'" conditional") -; htSaySaturn '"\\" -; bcConPredTable(consPred,conname) - -(DEFUN |dbShowConditions| (|htPage| |cAlist| |kind|) - (PROG (|conform| |conname| |article| |whichever| |LETTMP#1| - |consNoPred| |consPred| |singular| |plural|) - (RETURN - (PROGN - (SPADLET |conform| (|htpProperty| |htPage| '|conform|)) - (SPADLET |conname| (|opOf| |conform|)) - (SPADLET |article| (|htpProperty| |htPage| '|article|)) - (SPADLET |whichever| (|htpProperty| |htPage| '|whichever|)) - (SPADLET |LETTMP#1| (|splitConTable| |cAlist|)) - (SPADLET |consNoPred| (CAR |LETTMP#1|)) - (SPADLET |consPred| (CDR |LETTMP#1|)) - (SPADLET |singular| - (CONS |kind| (CONS " is" NIL))) - (SPADLET |plural| - (CONS (|pluralize| (STRINGIMAGE |kind|)) - (CONS " are" NIL))) - (|dbSayItems| (|#| |consNoPred|) |singular| |plural| - " unconditional") - (|htSaySaturn| "\\\\") - (|bcConPredTable| |consNoPred| |conname|) - (|htSayHrule|) - (|dbSayItems| (|#| |consPred|) |singular| |plural| - " conditional") - (|htSaySaturn| "\\\\") - (|bcConPredTable| |consPred| |conname|))))) - ;dbConsHeading(htPage,conlist,view,kind) == ; thing := htPage and htpProperty(htPage,'thing) or '"constructor" ; place :=