diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index f49c843..bd7e2fa 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -4990,6 +4990,23 @@ of the symbol being parsed. The original list read: \end{chunk} +\defun{parseLhs}{parseLhs} +\calls{parseLhs}{parseTran} +\calls{parseLhs}{transIs} +\begin{chunk}{defun parseLhs} +(defun |parseLhs| (x) + (let (result) + (cond + ((atom x) (|parseTran| x)) + ((atom (car x)) + (cons (|parseTran| (car x)) + (dolist (y (cdr x) (nreverse result)) + (push (|transIs| (|parseTran| y)) result)))) + (t (|parseTran| x))))) + +\end{chunk} + + \defplist{dollargreaterthan}{parseDollarGreaterthan} \begin{chunk}{postvars} (eval-when (eval load) @@ -5149,6 +5166,19 @@ of the symbol being parsed. The original list read: \end{chunk} +\defun{parseHas}{parseHas} +\calls{parseHas}{unabbrevAndLoad} +\calls{parseHas}{qcar} +\calls{parseHas}{qcdr} +\calls{parseHas}{getdatabase} +\calls{parseHas}{opOf} +\calls{parseHas}{makeNonAtomic} +\calls{parseHas}{parseHasRhs} +\calls{parseHas}{member} +\calls{parseHas}{parseType} +\calls{parseHas}{nreverse0} +\usesdollar{parseHas}{InteractiveMode} +\usesdollar{parseHas}{CategoryFrame} \begin{chunk}{defun parseHas} (defun |parseHas| (arg) (labels ( @@ -5203,7 +5233,33 @@ of the symbol being parsed. The original list read: (qcar tmp2) (cons '|and| tmp2))))) +\end{chunk} +\defun{parseHasRhs}{parseHasRhs} +\calls{parseHasRhs}{get} +\calls{parseHasRhs}{qcar} +\calls{parseHasRhs}{qcdr} +\calls{parseHasRhs}{member} +\calls{parseHasRhs}{abbreviation?} +\calls{parseHasRhs}{loadIfNecessary} +\calls{parseHasRhs}{unabbrevAndLoad} +\usesdollar{parseHasRhs}{CategoryFrame} +\begin{chunk}{defun parseHasRhs} +(defun |parseHasRhs| (u) + (let (tmp1 y) + (declare (special |$CategoryFrame|)) + (setq tmp1 (|get| u '|value| |$CategoryFrame|)) + (cond + ((and (pairp tmp1) (pairp (qcdr tmp1)) + (pairp (qcdr (qcdr tmp1))) (eq (qcdr (qcdr (qcdr tmp1))) nil) + (|member| (second tmp1) + '((|Mode|) (|Domain|) (|SubDomain| (|Domain|))))) + (second tmp1)) + ((setq y (|abbreviation?| u)) + (if (|loadIfNecessary| y) + (list (|unabbrevAndLoad| y)) + (list (list 'attribute u)))) + (t (list (list 'attribute u)))))) \end{chunk} @@ -14820,6 +14876,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun parseGreaterEqual} \getchunk{defun parseGreaterThan} \getchunk{defun parseHas} +\getchunk{defun parseHasRhs} \getchunk{defun parseIf} \getchunk{defun parseIf,ifTran} \getchunk{defun parseImplies} @@ -14832,6 +14889,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun parseLessEqual} \getchunk{defun parseLET} \getchunk{defun parseLETD} +\getchunk{defun parseLhs} \getchunk{defun parseMDEF} \getchunk{defun parseNot} \getchunk{defun parseNotEqual} diff --git a/changelog b/changelog index ccdaac4..56c6096 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20110303 tpd src/axiom-website/patches.html 20110303.01.tpd.patch +20110303 tpd src/interp/parsing.lisp treeshake compiler +20110303 tpd books/bookvol9 treeshake compiler 20110301 tpd src/axiom-website/patches.html 20110301.04.tpd.patch 20110301 tpd src/interp/parsing.lisp treeshake compiler 20110301 tpd books/bookvol9 treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 1848530..1986ec2 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3423,5 +3423,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20110301.04.tpd.patch books/bookvol9 treeshake compiler
+20110303.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index 0d491d5..add433b 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -1404,28 +1404,6 @@ parse (DEFUN |specialModeTran| (|form|) (PROG (|op| |argl| |sop| |s0| |argKey| |numArgs| |zeroOrOne| |isDmp| |LETTMP#1| |vl| |extraDomain| |s3| |isUpOrMp| |domainPart| |argPart| |n| |polyForm|) (RETURN (SEQ (COND ((AND (PAIRP |form|) (PROGN (SPADLET |op| (QCAR |form|)) (SPADLET |argl| (QCDR |form|)) (QUOTE T))) (COND ((NULL (ATOM |op|)) |form|) ((BOOT-EQUAL (SPADLET |s0| (ELT (SPADLET |sop| (PNAME |op|)) 0)) (QUOTE *)) (SPADLET |n| (|#| |sop|)) (COND ((EQL |n| 1) |form|) ((QUOTE T) (SPADLET |argKey| (ELT |sop| 1)) (SPADLET |numArgs| (SPADDIFFERENCE (|#| |argl|) (COND ((BOOT-EQUAL |argKey| (QUOTE |1|)) 1) ((QUOTE T) 0)))) (SPADLET |zeroOrOne| (OR (BOOT-EQUAL |argKey| (QUOTE |0|)) (BOOT-EQUAL |argKey| (QUOTE |1|)))) (SPADLET |isDmp| (COND ((> 10 |numArgs|) (AND (EQL |n| 6) (BOOT-EQUAL "DMP" (SUBSTRING |sop| 3 3)) |zeroOrOne|)) ((QUOTE T) (AND (EQL |n| 7) (BOOT-EQUAL "DMP" (SUBSTRING |sop| 4 3)) |zeroOrOne|)))) (COND (|isDmp| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) (SPADLET |extraDomain| |$EmptyMode|) (SPADLET |vl| |argl|)) ((QUOTE T) (SPADLET |LETTMP#1| (REVERSE |argl|)) (SPADLET |extraDomain| (CAR |LETTMP#1|)) (SPADLET |vl| (NREVERSE (CDR |LETTMP#1|))) |argl|)) (CONS (QUOTE |DistributedMultivariatePolynomial|) (CONS (CONS (QUOTE |construct|) |vl|) (CONS (|specialModeTran| |extraDomain|) NIL)))) ((AND (EQL |n| 4) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 3)) (QUOTE M)) |zeroOrOne|) (|specialModeTran| (PROGN (SPADLET |extraDomain| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) (CONS |$EmptyMode| NIL)) ((QUOTE T) NIL))) (COND ((EQL (SPADLET |n| (PARSE-INTEGER (PNAME (ELT |sop| 2)))) 1) (CONS (QUOTE |SquareMatrix|) (APPEND |argl| |extraDomain|))) ((EQL |n| 2) (CONS (QUOTE |RectangularMatrix|) (APPEND |argl| |extraDomain|))) ((QUOTE T) |form|))))) ((QUOTE T) (SPADLET |isUpOrMp| (COND ((> 10 |numArgs|) (OR (AND (EQL |n| 4) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 3)) (QUOTE P)) |zeroOrOne|) (AND (EQL |n| 5) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 3)) (QUOTE R)) (BOOT-EQUAL (ELT |sop| 4) (QUOTE F)) |zeroOrOne|))) ((QUOTE T) (OR (AND (EQL |n| 5) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 4)) (QUOTE P)) |zeroOrOne|) (AND (EQL |n| 6) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 4)) (QUOTE R)) (BOOT-EQUAL (ELT |sop| 5) (QUOTE F)) |zeroOrOne|))))) (COND (|isUpOrMp| (SPADLET |polyForm| (PROGN (SPADLET |domainPart| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) |$EmptyMode|) ((QUOTE T) (|last| |argl|)))) (SPADLET |argPart| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) |argl|) ((QUOTE T) (DROP (SPADDIFFERENCE 1) |argl|)))) (COND ((AND (> 10 |numArgs|) (EQL (SPADLET |n| (PARSE-INTEGER (PNAME (ELT |sop| 2)))) 1)) (CONS (QUOTE UP) (APPEND |argPart| (CONS |domainPart| NIL)))) ((QUOTE T) (CONS (QUOTE MP) (CONS (CONS (QUOTE |construct|) |argPart|) (CONS |domainPart| NIL))))))) (|specialModeTran| (COND ((BOOT-EQUAL |s3| (QUOTE R)) (CONS |$QuotientField| (CONS |polyForm| NIL))) ((QUOTE T) |polyForm|)))) ((QUOTE T) (CONS (CAR |form|) (PROG (#0=#:G166626) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166631 (CDR |form|) (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|specialModeTran| |x|) #0#))))))))))))))) ((QUOTE T) (CONS (CAR |form|) (PROG (#2=#:G166641) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G166646 (CDR |form|) (CDR #3#)) (|x| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |x| (CAR #3#)) NIL)) (NREVERSE0 #2#)) (SEQ (EXIT (SETQ #2# (CONS (|specialModeTran| |x|) #2#))))))))))) ((QUOTE T) |form|)))))) ; ; -;parseHasRhs u == --$InteractiveMode = true -; get(u,'value,$CategoryFrame) is [D,m,.] -; and m in '((Mode) (Domain) (SubDomain (Domain))) => m -; y := abbreviation? u => -; loadIfNecessary y => [unabbrevAndLoad y] -; [['ATTRIBUTE,u]] -; [['ATTRIBUTE,u]] - -;;; *** |parseHasRhs| REDEFINED - -(DEFUN |parseHasRhs| (|u|) (PROG (|ISTMP#1| D |ISTMP#2| |m| |ISTMP#3| |y|) (RETURN (COND ((AND (PROGN (SPADLET |ISTMP#1| (|get| |u| (QUOTE |value|) |$CategoryFrame|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET D (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |m| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL))))))) (|member| |m| (QUOTE ((|Mode|) (|Domain|) (|SubDomain| (|Domain|)))))) |m|) ((SPADLET |y| (|abbreviation?| |u|)) (COND ((|loadIfNecessary| |y|) (CONS (|unabbrevAndLoad| |y|) NIL)) ((QUOTE T) (CONS (CONS (QUOTE ATTRIBUTE) (CONS |u| NIL)) NIL)))) ((QUOTE T) (CONS (CONS (QUOTE ATTRIBUTE) (CONS |u| NIL)) NIL)))))) -; -; -;parseLhs x == -; atom x => parseTran x -; atom first x => [parseTran first x,:[transIs parseTran y for y in rest x]] -; parseTran x - -;;; *** |parseLhs| REDEFINED - -(DEFUN |parseLhs| (|x|) (PROG NIL (RETURN (SEQ (COND ((ATOM |x|) (|parseTran| |x|)) ((ATOM (CAR |x|)) (CONS (|parseTran| (CAR |x|)) (PROG (#0=#:G166888) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166893 (CDR |x|) (CDR #1#)) (|y| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|transIs| (|parseTran| |y|)) #0#))))))))) ((QUOTE T) (|parseTran| |x|))))))) -; ; ;parseTranCheckForRecord(x,op) == ; (x:= parseTran x) is ['Record,:l] =>