diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 3cbf73a..cd6c718 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -5364,6 +5364,29 @@ of the symbol being parsed. The original list read: \end{chunk} +\defun{convertOpAlist2compilerInfo}{convertOpAlist2compilerInfo} +\begin{chunk}{defun convertOpAlist2compilerInfo} +(defun |convertOpAlist2compilerInfo| (opalist) + (labels ( + (formatSig (op arg2) + (let (typelist slot stuff pred impl) + (setq typelist (car arg2)) + (setq slot (cadr arg2)) + (setq stuff (cddr arg2)) + (setq pred (if stuff (car stuff) t)) + (setq impl (if (cdr stuff) (cadr stuff) 'elt)) + (list (list op typelist) pred (list impl '$ slot))))) + (let (data result) + (setq data + (loop for item in opalist + collect + (loop for sig in (rest item) + collect (formatSig (car item) sig)))) + (dolist (term data result) + (setq result (append result item)))))) + +\end{chunk} + \defun{updateCategoryFrameForCategory}{updateCategoryFrameForCategory} \calls{updateCategoryFrameForCategory}{getdatabase} \calls{updateCategoryFrameForCategory}{put} @@ -7964,6 +7987,43 @@ where item has form \end{chunk} +\defun{isFunctor}{isFunctor} +\calls{isFunctor}{opOf} +\calls{isFunctor}{identp} +\calls{isFunctor}{getdatabase} +\calls{isFunctor}{get} +\calls{isFunctor}{constructor?} +\calls{isFunctor}{updateCategoryFrameForCategory} +\calls{isFunctor}{updateCategoryFrameForConstructor} +\refsdollar{isFunctor}{CategoryFrame} +\refsdollar{isFunctor}{InteractiveMode} +\begin{chunk}{defun isFunctor} +(defun |isFunctor| (x) + (let (op u prop) + (declare (special |$CategoryFrame| |$InteractiveMode|)) + (setq op (|opOf| x)) + (cond + ((null (identp op)) nil) + (|$InteractiveMode| + (if (member op '(|Union| |SubDomain| |Mapping| |Record|)) + t + (member (getdatabase op 'constructorkind) '(|domain| |package|)))) + ((setq u + (or (|get| op '|isFunctor| |$CategoryFrame|) + (member op '(|SubDomain| |Union| |Record|)))) + u) + ((|constructor?| op) + (cond + ((setq prop (|get| op '|isFunctor| |$CategoryFrame|)) prop) + (t + (if (eq (getdatabase op 'constructorkind) '|category|) + (|updateCategoryFrameForCategory| op) + (|updateCategoryFrameForConstructor| op)) + (|get| op '|isFunctor| |$CategoryFrame|)))) + (t nil)))) + +\end{chunk} + \defun{getDomainsInScope}{getDomainsInScope} The way XLAMs work: \begin{verbatim} @@ -17868,6 +17928,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun compWithMappingMode1} \getchunk{defun containsBang} \getchunk{defun convert} +\getchunk{defun convertOpAlist2compilerInfo} \getchunk{defun current-char} \getchunk{defun current-symbol} \getchunk{defun current-token} @@ -17933,6 +17994,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun is-console} \getchunk{defun isDomainConstructorForm} \getchunk{defun isDomainForm} +\getchunk{defun isFunctor} \getchunk{defun isListConstructor} \getchunk{defun isSuperDomain} \getchunk{defun isTokenDelimiter} diff --git a/changelog b/changelog index 33460c7..20b6965 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20110722 tpd src/axiom-website/patches.html 20110722.01.tpd.patch +20110722 tpd src/interp/lisplib.lisp treeshake compiler +20110722 tpd books/bookvol9 treeshake compiler 20110721 tpd src/axiom-website/patches.html 20110721.01.tpd.patch 20110721 tpd src/interp/vmlisp.lisp treeshake compiler 20110721 tpd src/interp/lisplib.lisp treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 718f3c0..4f2fdbf 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3550,5 +3550,7 @@ books/bookvol5 treeshake interpreter
books/bookvol9 treeshake compiler
20110721.01.tpd.patch books/bookvol9 treeshake compiler
+20110722.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/lisplib.lisp.pamphlet b/src/interp/lisplib.lisp.pamphlet index 32cb445..0a27a0d 100644 --- a/src/interp/lisplib.lisp.pamphlet +++ b/src/interp/lisplib.lisp.pamphlet @@ -177,73 +177,6 @@ ((GETL |libName| 'LOADED) NIL) ('T (|loadLib| |libName|)))) -;convertOpAlist2compilerInfo(opalist) == -; "append"/[[formatSig(op,sig) for sig in siglist] -; for [op,:siglist] in opalist] where -; formatSig(op, [typelist, slot,:stuff]) == -; pred := if stuff then first stuff else 'T -; impl := if CDR stuff then CADR stuff else 'ELT -- handles 'CONST -; [[op, typelist], pred, [impl, '$, slot]] - -(DEFUN |convertOpAlist2compilerInfo,formatSig| (|op| G166245) - (PROG (|typelist| |slot| |stuff| |pred| |impl|) - (RETURN - (SEQ (PROGN - (SPADLET |typelist| (CAR G166245)) - (SPADLET |slot| (CADR G166245)) - (SPADLET |stuff| (CDDR G166245)) - G166245 - (SEQ (SPADLET |pred| (IF |stuff| (CAR |stuff|) 'T)) - (SPADLET |impl| - (IF (CDR |stuff|) (CADR |stuff|) 'ELT)) - (EXIT (CONS (CONS |op| (CONS |typelist| NIL)) - (CONS |pred| - (CONS - (CONS |impl| - (CONS '$ (CONS |slot| NIL))) - NIL)))))))))) - - -(DEFUN |convertOpAlist2compilerInfo| (|opalist|) - (PROG (|op| |siglist|) - (RETURN - (SEQ (PROG (G166272) - (SPADLET G166272 NIL) - (RETURN - (DO ((G166278 |opalist| (CDR G166278)) - (G166264 NIL)) - ((OR (ATOM G166278) - (PROGN (SETQ G166264 (CAR G166278)) NIL) - (PROGN - (PROGN - (SPADLET |op| (CAR G166264)) - (SPADLET |siglist| (CDR G166264)) - G166264) - NIL)) - G166272) - (SEQ (EXIT (SETQ G166272 - (APPEND G166272 - (PROG (G166289) - (SPADLET G166289 NIL) - (RETURN - (DO - ((G166294 |siglist| - (CDR G166294)) - (|sig| NIL)) - ((OR (ATOM G166294) - (PROGN - (SETQ |sig| - (CAR G166294)) - NIL)) - (NREVERSE0 G166289)) - (SEQ - (EXIT - (SETQ G166289 - (CONS - (|convertOpAlist2compilerInfo,formatSig| - |op| |sig|) - G166289)))))))))))))))))) - ;makeConstructorsAutoLoad() == ; for cnam in allConstructors() repeat ; REMPROP(cnam,'LOADED) @@ -1173,58 +1106,6 @@ (setq |sig| (CDAR |mm|)) |sig|) ('T NIL))))) -;isFunctor x == -; op:= opOf x -; not IDENTP op => false -; $InteractiveMode => -; MEMQ(op,'(Union SubDomain Mapping Record)) => true -; MEMQ(GETDATABASE(op,'CONSTRUCTORKIND),'(domain package)) -; u:= get(op,'isFunctor,$CategoryFrame) -; or MEMQ(op,'(SubDomain Union Record)) => u -; constructor? op => -; prop := get(op,'isFunctor,$CategoryFrame) => prop -; if GETDATABASE(op,'CONSTRUCTORKIND) = 'category -; then updateCategoryFrameForCategory op -; else updateCategoryFrameForConstructor op -; get(op,'isFunctor,$CategoryFrame) -; nil -; -; -; - -(DEFUN |isFunctor| (|x|) - (PROG (|op| |u| |prop|) - (declare (special |$CategoryFrame| |$InteractiveMode|)) - (RETURN - (PROGN - (setq |op| (|opOf| |x|)) - (COND - ((NULL (IDENTP |op|)) NIL) - (|$InteractiveMode| - (COND - ((member |op| '(|Union| |SubDomain| |Mapping| |Record|)) - 'T) - ('T - (member (GETDATABASE |op| 'CONSTRUCTORKIND) - '(|domain| |package|))))) - ((setq |u| - (OR (|get| |op| '|isFunctor| |$CategoryFrame|) - (member |op| '(|SubDomain| |Union| |Record|)))) - |u|) - ((|constructor?| |op|) - (COND - ((setq |prop| - (|get| |op| '|isFunctor| |$CategoryFrame|)) - |prop|) - ('T - (COND - ((BOOT-EQUAL (GETDATABASE |op| 'CONSTRUCTORKIND) - '|category|) - (|updateCategoryFrameForCategory| |op|)) - ('T (|updateCategoryFrameForConstructor| |op|))) - (|get| |op| '|isFunctor| |$CategoryFrame|)))) - ('T NIL)))))) - \end{chunk} \eject \begin{thebibliography}{99}