diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index cc11a37..799c22d 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -1542,6 +1542,13 @@ always positioned ON the first character. @ +\defplist{construct}{parseConstruct} +<>= +(eval-when (eval load) + (setf (get '|construct| '|parseTran|) '|parseConstruct|)) + +@ + \defun{parseConstruct}{parseConstruct} \calls{parseConstruct}{parseTranList} \usesdollar{parseConstruct}{insideConstructIfTrue} @@ -1556,6 +1563,344 @@ always positioned ON the first character. @ \section{Indirect called parse routines} +In the {\bf parseTran} function there is the code: +\begin{verbatim} + ((and (atom u) (setq fn (getl u '|parseTran|))) + (funcall fn argl)) +\end{verbatim} + +The functions in this section are called through the symbol-plist +of the symbol being parsed. The original list read: + +\begin{verbatim} + and parseAnd + @ parseAtSign + CATEGORY parseCategory + :: parseCoerce + \: parseColon + construct parseConstruct + DEF parseDEF + $<= parseDollarLessEqual + $> parseDollarGreaterThan + $>= parseDollarGreaterEqual + ($^= parseDollarNotEqual + eqv parseEquivalence +;;xor parseExclusiveOr + exit parseExit + > parseGreaterThan + >= parseGreaterEqual + has parseHas + IF parseIf + implies parseImplies + IN parseIn + INBY parseInBy + is parseIs + isnt parseIsnt + Join parseJoin + leave parseLeave +;;control-H parseLeftArrow + <= parseLessEqual + LET parseLET + LETD parseLETD + MDEF parseMDEF + ^ parseNot + not parseNot + ^= parseNotEqual + or parseOr + pretend parsePretend + return parseReturn + SEGMENT parseSegment + SEQ parseSeq +;;control-V parseUpArrow + VCONS parseVCONS + where parseWhere +\end{verbatim} + + +\defplist{and}{parseAnd} +<>= +(eval-when (eval load) + (setf (get '|and| '|parseTran|) '|parseAnd|)) + +@ + +\defun{parseAnd}{parseAnd} +\calls{parseAnd}{parseTran} +\calls{parseAnd}{parseAnd} +\calls{parseAnd}{parseTranList} +\calls{parseAnd}{parseIf} +\usesdollar{parseAnd}{InteractiveMode} +<>= +(defun |parseAnd| (arg) + (cond + (|$InteractiveMode| (cons '|and| (|parseTranList| arg))) + ((null arg) '|true|) + ((null (cdr arg)) (car arg)) + (t + (|parseIf| + (list (|parseTran| (car arg)) (|parseAnd| (CDR arg)) '|false| ))))) + +@ + +\defplist{@}{parseAtSign} +<>= +(eval-when (eval load) + (setf (get '@ '|parseTran|) '|parseAtSign|)) + +@ + +\defun{parseAtSign}{parseAtSign} +\calls{parseAtSign}{parseTran} +\calls{parseAtSign}{parseType} +\usesdollar{parseAtSign}{InteractiveMode} +<>= +(defun |parseAtSign| (arg) + (declare (special |$InteractiveMode|)) + (if |$InteractiveMode| + (list '@ (|parseTran| (first arg)) (|parseTran| (|parseType| (second arg)))) + (list '@ (|parseTran| (first arg)) (|parseTran| (second arg))))) + +@ + +\defplist{category}{parseCategory} +<>= +(eval-when (eval load) + (setf (get 'category '|parseTran|) '|parseCategory|)) + +@ + +\defun{parseCategory}{parseCategory} +\calls{parseCategory}{parseTranList} +\calls{parseCategory}{parseDropAssertions} +\calls{parseCategory}{contained} +<>= +(defun |parseCategory| (arg) + (let (z key) + (setq z (|parseTranList| (|parseDropAssertions| arg))) + (setq key (if (contained '$ z) '|domain| '|package|)) + (cons 'category (cons key z)))) + +@ + +\defplist{::}{parseCoerce} +<>= +(eval-when (eval load) + (setf (get '|::| '|parseTran|) '|parseCoerce|)) + +@ + +\defun{parseCoerce}{parseCoerce} +\calls{parseCoerce}{parseType} +\calls{parseCoerce}{parseTran} +\usesdollar{parseCoerce}{InteractiveMode} +<>= +(defun |parseCoerce| (arg) + (if |$InteractiveMode| + (list '|::| + (|parseTran| (first arg)) (|parseTran| (|parseType| (second arg)))) + (list '|::| (|parseTran| (first arg)) (|parseTran| (second arg))))) + +@ + +\defplist{:}{parseColon} +<>= +(eval-when (eval load) + (setf (get '|:| '|parseTran|) '|parseColon|)) + +@ + +\defun{parseColon}{parseColon} +\calls{parseColon}{parseTran} +\calls{parseColon}{parseType} +\usesdollar{parseColon}{InteractiveMode} +\usesdollar{parseColon}{insideConstructIfTrue} +<>= +(defun |parseColon| (arg) + (cond + ((and (pairp arg) (eq (qcdr arg) nil)) + (list '|:| (|parseTran| (first arg)))) + ((and (pairp arg) (pairp (qcdr arg)) (eq (qcdr (qcdr arg)) nil)) + (if |$InteractiveMode| + (if |$insideConstructIfTrue| + (list 'tag (|parseTran| (first arg)) + (|parseTran| (second arg))) + (list '|:| (|parseTran| (first arg)) + (|parseTran| (|parseType| (second arg))))) + (list '|:| (|parseTran| (first arg)) + (|parseTran| (second arg))))))) + +@ + +\defplist{def}{parseDEF} +<>= +(eval-when (eval load) + (setf (get 'def '|parseTran|) '|parseDEF|)) + +@ + +\defun{parseDEF}{parseDEF} +\calls{parseDEF}{setDefOp} +\calls{parseDEF}{parseLhs} +\calls{parseDEF}{parseTranList} +\calls{parseDEF}{parseTranCheckForRecord} +\calls{parseDEF}{opFf} +\usesdollar{parseDEF}{lhs} +<>= +(defun |parseDEF| (arg) + (let (|$lhs| tList specialList body) + (declare (special |$lhs|)) + (setq |$lhs| (first arg)) + (setq tList (second arg)) + (setq specialList (third arg)) + (setq body (fourth arg)) + (|setDefOp| |$lhs|) + (list 'def (|parseLhs| |$lhs|) + (|parseTranList| tList) + (|parseTranList| specialList) + (|parseTranCheckForRecord| body (|opOf| |$lhs|))))) + +@ + +\defplist{eqv}{parseEquivalence} +<>= +(eval-when (eval load) + (setf (get '|eqv| '|parseTran|) '|parseEquivalence|)) + +@ + +\defun{parseEquivalence}{parseEquivalence} +\calls{parseEquivalence}{parseIf} +<>= +(defun |parseEquivalence| (arg) + (|parseIf| + (list (first arg) (second arg) + (|parseIf| (cons (second arg) '(|false| |true|)))))) + +@ + +\defplist{>=}{parseExit} +<>= +(eval-when (eval load) + (setf (get '|exit| '|parseTran|) '|parseExit|)) + +@ + +\defun{parseExit}{parseExit} +\calls{parseExit}{parseTran} +\calls{parseExit}{moan} +<>= +(defun |parseExit| (arg) + (let (a b) + (setq a (|parseTran| (car arg))) + (setq b (|parseTran| (cdr arg))) + (if b + (cond + ((null (integerp a)) + (moan "first arg " a " for exit must be integer") + (list '|exit| 1 a )) + (t + (cons '|exit| (cons a b)))) + (list '|exit| 1 a )))) + +@ + +\defplist{>=}{parseGreaterEqual} +<>= +(eval-when (eval load) + (setf (get '|>=| '|parseTran|) '|parseGreaterEqual|)) + +@ + +\defun{parseGreaterEqual}{parseGreaterEqual} +\calls{parseGreaterEqual}{parseTran} +\usesdollar{parseGreaterEqual}{op} +<>= +(defun |parseGreaterEqual| (arg) + (declare (special |$op|)) + (|parseTran| (list '|not| (cons (msubst '< '>= |$op|) arg)))) + +@ + +\defplist{>}{parseGreaterThan} +<>= +(eval-when (eval load) + (setf (get '|>| '|parseTran|) '|parseGreaterThan|)) + +@ + +\defun{parseGreaterThan}{parseGreaterThan} +\calls{parseGreaterThan}{parseTran} +<>= +(defun |parseGreaterThan| (arg) + (list (msubst '< '> |$op|) + (|parseTran| (second arg)) (|parseTran| (first arg)))) + +@ + +\defplist{has}{parseHas} +<>= +(eval-when (eval load) + (setf (get '|has| '|parseTran|) '|parseHas|)) + +@ + +<>= +(defun |parseHas| (arg) + (labels ( + (fn (arg) + (let (tmp4 tmp6 map op kk) + (declare (special |$InteractiveMode|)) + (when |$InteractiveMode| (setq arg (|unabbrevAndLoad| arg))) + (cond + ((and (pairp arg) (eq (qcar arg) '|:|) (pairp (qcdr arg)) + (pairp (qcdr (qcdr arg))) (eq (qcdr (qcdr (qcdr arg))) nil) + (pairp (qcar (qcdr (qcdr arg)))) + (eq (qcar (qcar (qcdr (qcdr arg)))) '|Mapping|)) + (setq map (rest (third arg))) + (setq op (second arg)) + (setq op (if (stringp op) (intern op) op)) + (list (list 'signature op map))) + ((and (pairp arg) (eq (qcar arg) '|Join|)) + (dolist (z (rest arg) tmp4) + (setq tmp4 (append tmp4 (fn z))))) + ((and (pairp arg) (eq (qcar arg) 'category)) + (dolist (z (rest arg) tmp6) + (setq tmp6 (append tmp6 (fn z))))) + (t + (setq kk (getdatabase (|opOf| arg) 'constructorkind)) + (cond + ((or (eq kk '|domain|) (eq kk '|category|)) + (list (|makeNonAtomic| arg))) + ((and (pairp arg) (eq (qcar arg) 'attribute)) + (list arg)) + ((and (pairp arg) (eq (qcar arg) 'signature)) + (list arg)) + (|$InteractiveMode| + (|parseHasRhs| arg)) + (t + (list (list 'attribute arg))))))))) + (let (tmp1 tmp2 tmp3 x) + (declare (special |$InteractiveMode| |$CategoryFrame|)) + (setq x (first arg)) + (setq tmp1 (|get| x '|value| |$CategoryFrame|)) + (when |$InteractiveMode| + (setq x + (if (and (pairp tmp1) (pairp (qcdr tmp1)) (pairp (qcdr (qcdr tmp1))) + (eq (qcdr (qcdr (qcdr tmp1))) nil) + (|member| (second tmp1) + '((|Mode|) (|Domain|) (|SubDomain| (|Domain|))))) + (first tmp1) + (|parseType| x)))) + (setq tmp2 + (dolist (u (fn (second arg)) (nreverse0 tmp3)) + (push (list '|has| x u ) tmp3))) + (if (and (pairp tmp2) (eq (qcdr tmp2) nil)) + (qcar tmp2) + (cons '|and| tmp2))))) + + + +@ \defplist{parseTran}{parseLeave} <>= @@ -1563,6 +1908,7 @@ always positioned ON the first character. (setf (get '|leave| '|parseTran|) '|parseLeave|)) @ + \defun{parseLeave}{parseLeave} \calls{parseLeave}{parseTran} <>= @@ -1581,6 +1927,22 @@ always positioned ON the first character. @ +\defplist{<=}{parseLessEqual} +<>= +(eval-when (eval load) + (setf (get '|<=| '|parseTran|) '|parseLessEqual|)) + +@ + +\defun{parseLessEqual}{parseLessEqual} +\calls{parseLessEqual}{parseTran} +\usesdollar{parseLessEqual}{op} +<>= +(defun |parseLessEqual| (arg) + (declare (special |$op|)) + (|parseTran| (list '|not| (cons (msubst '> '<= |$op|) arg)))) + +@ \chapter{Post Transformers} \section{Direct called postparse routines} \defun{postTransform}{postTransform} @@ -1770,15 +2132,15 @@ always positioned ON the first character. \calls{postError}{nequal} \calls{postError}{bumperrorcount} \usesdollar{postError}{defOp} -% \usesdollar{postError}{InteractiveMode} original source code bug +\usesdollar{postError}{InteractiveMode} \usesdollar{postError}{postStack} <>= (defun |postError| (msg) (let (xmsg) - (declare (special |$defOp| |$postStack|)) + (declare (special |$defOp| |$postStack| |$InteractiveMode|)) (bumperrorcount '|precompilation|) (setq xmsg - (if (and (nequal |$defOp| '|$defOp|) (null |InteractiveMode|)) + (if (and (nequal |$defOp| '|$defOp|) (null |$InteractiveMode|)) (cons |$defOp| (cons ": " msg)) msg)) (push xmsg |$postStack|) @@ -1977,6 +2339,7 @@ of the symbol being parsed. The original list read: \usesdollar{postCategory}{insidePostCategoryIfTrue} <>= (defun |postCategory| (u) + (declare (special |$insidePostCategoryIfTrue|)) (labels ( (fn (arg) (let (|$insidePostCategoryIfTrue|) @@ -2011,7 +2374,7 @@ of the symbol being parsed. The original list read: ((dolist (x (qcdr y) tmp5) (setq tmp5 (or tmp5 (and (pairp x) (eq (qcar x) 'segment))))) (|tuple2List| (qcdr y))) - (t (cons '|construct| (|postTranList| l))))) + (t (cons '|construct| (|postTranList| (qcdr y)))))) (list 'reduce '|append| 0 (cons op (append itl (list newBody))))) (t (cons op (append itl (list y))))))) @@ -2031,7 +2394,7 @@ of the symbol being parsed. The original list read: \calls{postCollect}{postTran} <>= (defun |postCollect| (arg) - (let (constructOp tmp3 m d itl x) + (let (constructOp tmp3 m itl x) (setq constructOp (car arg)) (setq tmp3 (reverse (cdr arg))) (setq x (car tmp3)) @@ -2188,7 +2551,7 @@ of the symbol being parsed. The original list read: \usesdollar{postDef}{InteractiveMode} <>= (defun |postDef| (arg) - (let (defOp rhs name lhs targetType a tmp1 op argl newLhs + (let (defOp rhs lhs targetType tmp1 op argl newLhs argTypeList typeList form specialCaseForm tmp4 tmp6 tmp8) (declare (special $boot |$maxSignatureLineNumber| |$headerDocumentation| |$docList| |$InteractiveMode|)) @@ -9260,10 +9623,22 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> <> +<> +<> +<> +<> <> +<> +<> +<> <> +<> +<> +<> <> +<> <> <> <> diff --git a/changelog b/changelog index 9ef1ade..dc1542d 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20101111 tpd src/axiom-website/patches.html 20101111.01.tpd.patch +20101111 tpd src/interp/vmlisp.lisp treeshake compiler +20101111 tpd src/interp/parsing.lisp treeshake compiler +20101111 tpd books/bookvol9 treeshake compiler 20101108 tpd src/axiom-website/patches.html 20101108.01.tpd.patch 20101108 tpd src/interp/vmlisp.lisp treeshake compiler 20101108 tpd src/interp/parsing.lisp treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index a86749c..0d7b172 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3258,6 +3258,8 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20101108.01.tpd.patch books/bookvol9 treeshake compiler
+20101111.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index faaf26c..501b4e3 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -1695,17 +1695,6 @@ parse (DEFUN |parseLETD| (#0=#:G166305) (PROG (|x| |y|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |y| (CADR #0#)) (CONS (QUOTE LETD) (CONS (|parseTran| |x|) (CONS (|parseTran| (|parseType| |y|)) NIL))))))) ; -;parseColon u == -; u is [x] => [":",parseTran x] -; u is [x,typ] => -; $InteractiveMode => -; $insideConstructIfTrue=true => ['TAG,parseTran x,parseTran typ] -; [":",parseTran x,parseTran parseType typ] -; [":",parseTran x,parseTran typ] - -;;; *** |parseColon| REDEFINED - -(DEFUN |parseColon| (|u|) (PROG (|x| |ISTMP#1| |typ|) (RETURN (COND ((AND (PAIRP |u|) (EQ (QCDR |u|) NIL) (PROGN (SPADLET |x| (QCAR |u|)) (QUOTE T))) (CONS (QUOTE |:|) (CONS (|parseTran| |x|) NIL))) ((AND (PAIRP |u|) (PROGN (SPADLET |x| (QCAR |u|)) (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |typ| (QCAR |ISTMP#1|)) (QUOTE T))))) (COND (|$InteractiveMode| (COND ((BOOT-EQUAL |$insideConstructIfTrue| (QUOTE T)) (CONS (QUOTE TAG) (CONS (|parseTran| |x|) (CONS (|parseTran| |typ|) NIL)))) ((QUOTE T) (CONS (QUOTE |:|) (CONS (|parseTran| |x|) (CONS (|parseTran| (|parseType| |typ|)) NIL)))))) ((QUOTE T) (CONS (QUOTE |:|) (CONS (|parseTran| |x|) (CONS (|parseTran| |typ|) NIL)))))))))) ; ;parseBigelt [typ,consForm] == ; [['elt,typ,'makeRecord],:transUnCons consForm] @@ -1727,21 +1716,7 @@ parse (DEFUN |transUnCons| (|u|) (PROG (|ISTMP#1| |x| |ISTMP#2| |y|) (RETURN (COND ((ATOM |u|) (|systemErrorHere| "transUnCons")) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE APPEND)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((NULL |y|) |x|) ((QUOTE T) (|systemErrorHere| "transUnCons")))) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE CONS)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((ATOM |y|) (CONS |x| |y|)) ((QUOTE T) (CONS |x| (|transUnCons| |y|))))))))) ; -;parseCoerce [x,typ] == -; $InteractiveMode => ["::",parseTran x,parseTran parseType typ] -; ["::",parseTran x,parseTran typ] - -;;; *** |parseCoerce| REDEFINED - -(DEFUN |parseCoerce| (#0=#:G166399) (PROG (|x| |typ|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |typ| (CADR #0#)) (COND (|$InteractiveMode| (CONS (QUOTE |::|) (CONS (|parseTran| |x|) (CONS (|parseTran| (|parseType| |typ|)) NIL)))) ((QUOTE T) (CONS (QUOTE |::|) (CONS (|parseTran| |x|) (CONS (|parseTran| |typ|) NIL))))))))) ; -;parseAtSign [x,typ] == -; $InteractiveMode => ["@",parseTran x,parseTran parseType typ] -; ["@",parseTran x,parseTran typ] - -;;; *** |parseAtSign| REDEFINED - -(DEFUN |parseAtSign| (#0=#:G166414) (PROG (|x| |typ|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |typ| (CADR #0#)) (COND (|$InteractiveMode| (CONS (QUOTE @) (CONS (|parseTran| |x|) (CONS (|parseTran| (|parseType| |typ|)) NIL)))) ((QUOTE T) (CONS (QUOTE @) (CONS (|parseTran| |x|) (CONS (|parseTran| |typ|) NIL))))))))) ; ;parsePretend [x,typ] == ; $InteractiveMode => ['pretend,parseTran x,parseTran parseType typ] @@ -1872,41 +1847,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|)))))) ; -;parseHas [x,y] == -; if $InteractiveMode then -; x:= -; get(x,'value,$CategoryFrame) is [D,m,.] -; and m in '((Mode) (Domain) (SubDomain (Domain))) => D -; parseType x -; mkand [['has,x,u] for u in fn y] where -; mkand x == -; x is [a] => a -; ['and,:x] -; fn y == -; if $InteractiveMode then y:= unabbrevAndLoad y -; y is [":" ,op,['Mapping,:map]] => -; op:= (STRINGP op => INTERN op; op) -; [['SIGNATURE,op,map]] -; y is ['Join,:u] => "append"/[fn z for z in u] -; y is ['CATEGORY,:u] => "append"/[fn z for z in u] -; kk:= GETDATABASE(opOf y,'CONSTRUCTORKIND) -; kk = 'domain or kk = 'category => [makeNonAtomic y] -; y is ['ATTRIBUTE,:.] => [y] -; y is ['SIGNATURE,:.] => [y] -; $InteractiveMode => parseHasRhs y -; [['ATTRIBUTE,y]] - -;;; *** |parseHas,fn| REDEFINED - -(DEFUN |parseHas,fn| (|y|) (PROG (|ISTMP#1| |ISTMP#2| |ISTMP#3| |map| |op| |u| |kk|) (RETURN (SEQ (IF |$InteractiveMode| (SPADLET |y| (|unabbrevAndLoad| |y|)) NIL) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |y|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |op| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |Mapping|)) (PROGN (SPADLET |map| (QCDR |ISTMP#3|)) (QUOTE T))))))))) (EXIT (SEQ (SPADLET |op| (SEQ (IF (STRINGP |op|) (EXIT (INTERN |op|))) (EXIT |op|))) (EXIT (CONS (CONS (QUOTE SIGNATURE) (CONS |op| (CONS |map| NIL))) NIL))))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |Join|)) (PROGN (SPADLET |u| (QCDR |y|)) (QUOTE T))) (EXIT (PROG (#0=#:G166738) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166743 |u| (CDR #1#)) (|z| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |z| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (APPEND #0# (|parseHas,fn| |z|)))))))))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE CATEGORY)) (PROGN (SPADLET |u| (QCDR |y|)) (QUOTE T))) (EXIT (PROG (#2=#:G166749) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G166754 |u| (CDR #3#)) (|z| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |z| (CAR #3#)) NIL)) #2#) (SEQ (EXIT (SETQ #2# (APPEND #2# (|parseHas,fn| |z|)))))))))) (SPADLET |kk| (GETDATABASE (|opOf| |y|) (QUOTE CONSTRUCTORKIND))) (IF (OR (BOOT-EQUAL |kk| (QUOTE |domain|)) (BOOT-EQUAL |kk| (QUOTE |category|))) (EXIT (CONS (|makeNonAtomic| |y|) NIL))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE ATTRIBUTE))) (EXIT (CONS |y| NIL))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE SIGNATURE))) (EXIT (CONS |y| NIL))) (IF |$InteractiveMode| (EXIT (|parseHasRhs| |y|))) (EXIT (CONS (CONS (QUOTE ATTRIBUTE) (CONS |y| NIL)) NIL)))))) - -;;; *** |parseHas,mkand| REDEFINED - -(DEFUN |parseHas,mkand| (|x|) (PROG (|a|) (RETURN (SEQ (IF (AND (PAIRP |x|) (EQ (QCDR |x|) NIL) (PROGN (SPADLET |a| (QCAR |x|)) (QUOTE T))) (EXIT |a|)) (EXIT (CONS (QUOTE |and|) |x|)))))) - -;;; *** |parseHas| REDEFINED - -(DEFUN |parseHas| (#0=#:G166781) (PROG (|y| |ISTMP#1| D |ISTMP#2| |m| |ISTMP#3| |x|) (RETURN (SEQ (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |y| (CADR #0#)) (COND (|$InteractiveMode| (SPADLET |x| (COND ((AND (PROGN (SPADLET |ISTMP#1| (|get| |x| (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|)))))) D) ((QUOTE T) (|parseType| |x|)))))) (|parseHas,mkand| (PROG (#1=#:G166802) (SPADLET #1# NIL) (RETURN (DO ((#2=#:G166807 (|parseHas,fn| |y|) (CDR #2#)) (|u| NIL)) ((OR (ATOM #2#) (PROGN (SETQ |u| (CAR #2#)) NIL)) (NREVERSE0 #1#)) (SEQ (EXIT (SETQ #1# (CONS (CONS (QUOTE |has|) (CONS |x| (CONS |u| NIL))) #1#))))))))))))) ; ;parseHasRhs u == --$InteractiveMode = true ; get(u,'value,$CategoryFrame) is [D,m,.] @@ -1920,14 +1860,6 @@ parse (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)))))) ; -;parseDEF [$lhs,tList,specialList,body] == -; setDefOp $lhs -; ['DEF,parseLhs $lhs,parseTranList tList,parseTranList specialList, -; parseTranCheckForRecord(body,opOf $lhs)] - -;;; *** |parseDEF| REDEFINED - -(DEFUN |parseDEF| (#0=#:G166861) (PROG (|$lhs| |tList| |specialList| |body|) (DECLARE (SPECIAL |$lhs|)) (RETURN (PROGN (SPADLET |$lhs| (CAR #0#)) (SPADLET |tList| (CADR #0#)) (SPADLET |specialList| (CADDR #0#)) (SPADLET |body| (CADDDR #0#)) (|setDefOp| |$lhs|) (CONS (QUOTE DEF) (CONS (|parseLhs| |$lhs|) (CONS (|parseTranList| |tList|) (CONS (|parseTranList| |specialList|) (CONS (|parseTranCheckForRecord| |body| (|opOf| |$lhs|)) NIL))))))))) ; ;parseLhs x == ; atom x => parseTran x @@ -1972,16 +1904,6 @@ parse (DEFUN |parseCases| (#0=#:G167006) (PROG (|expr| |ifClause|) (RETURN (PROGN (SPADLET |expr| (CAR #0#)) (SPADLET |ifClause| (CADR #0#)) (|parseCases,casefn| |expr| |ifClause|))))) ; -;parseCategory x == -; l:= parseTranList parseDropAssertions x -; key:= -; CONTAINED("$",l) => "domain" -; 'package -; ['CATEGORY,key,:l] - -;;; *** |parseCategory| REDEFINED - -(DEFUN |parseCategory| (|x|) (PROG (|l| |key|) (RETURN (PROGN (SPADLET |l| (|parseTranList| (|parseDropAssertions| |x|))) (SPADLET |key| (COND ((CONTAINED (QUOTE $) |l|) (QUOTE |domain|)) ((QUOTE T) (QUOTE |package|)))) (CONS (QUOTE CATEGORY) (CONS |key| |l|)))))) ; ;parseDropAssertions x == ;--note: the COPY of this list is necessary-- do not replace by RPLACing version @@ -1994,24 +1916,8 @@ parse (DEFUN |parseDropAssertions| (|x|) (PROG (|y| |r| |ISTMP#1|) (RETURN (COND ((AND (PAIRP |x|) (PROGN (SPADLET |y| (QCAR |x|)) (SPADLET |r| (QCDR |x|)) (QUOTE T))) (COND ((AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |y|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |asserted|))))) (|parseDropAssertions| |r|)) ((QUOTE T) (CONS |y| (|parseDropAssertions| |r|))))) ((QUOTE T) |x|))))) ; -;parseGreaterThan [x,y] == -; [substitute("<",">",$op),parseTran y,parseTran x] - -;;; *** |parseGreaterThan| REDEFINED - -(DEFUN |parseGreaterThan| (#0=#:G167040) (PROG (|x| |y|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |y| (CADR #0#)) (CONS (MSUBST (QUOTE <) (QUOTE >) |$op|) (CONS (|parseTran| |y|) (CONS (|parseTran| |x|) NIL))))))) -; -;parseGreaterEqual u == parseTran ['not,[substitute("<",">=",$op),:u]] - -;;; *** |parseGreaterEqual| REDEFINED - -(DEFUN |parseGreaterEqual| (|u|) (|parseTran| (CONS (QUOTE |not|) (CONS (CONS (MSUBST (QUOTE <) (QUOTE >=) |$op|) |u|) NIL)))) ; -;parseLessEqual u == parseTran ['not,[substitute(">","<=",$op),:u]] -;;; *** |parseLessEqual| REDEFINED - -(DEFUN |parseLessEqual| (|u|) (|parseTran| (CONS (QUOTE |not|) (CONS (CONS (MSUBST (QUOTE >) (QUOTE <=) |$op|) |u|) NIL)))) ; ;parseNotEqual u == parseTran ['not,[substitute("=","^=",$op),:u]] @@ -2047,16 +1953,6 @@ parse (DEFUN |parseDollarNotEqual| (|u|) (|parseTran| (CONS (QUOTE |not|) (CONS (CONS (MSUBST (QUOTE $=) (QUOTE $^=) |$op|) |u|) NIL)))) ; -;parseAnd u == -; $InteractiveMode => ['and,:parseTranList u] -; null u => 'true -; null rest u => first u -; parseIf [parseTran first u,parseAnd rest u,"false"] - -;;; *** |parseAnd| REDEFINED - -(DEFUN |parseAnd| (|u|) (COND (|$InteractiveMode| (CONS (QUOTE |and|) (|parseTranList| |u|))) ((NULL |u|) (QUOTE |true|)) ((NULL (CDR |u|)) (CAR |u|)) ((QUOTE T) (|parseIf| (CONS (|parseTran| (CAR |u|)) (CONS (|parseAnd| (CDR |u|)) (CONS (QUOTE |false|) NIL))))))) -; ;parseOr u == ; $InteractiveMode => ['or,:parseTranList u] ; null u => 'false @@ -2076,11 +1972,6 @@ parse (DEFUN |parseNot| (|u|) (COND (|$InteractiveMode| (CONS (QUOTE |not|) (CONS (|parseTran| (CAR |u|)) NIL))) ((QUOTE T) (|parseTran| (CONS (QUOTE IF) (CONS (CAR |u|) (QUOTE (|false| |true|)))))))) ; -;parseEquivalence [a,b] == parseIf [a,b,parseIf [b,:'(false true)]] - -;;; *** |parseEquivalence| REDEFINED - -(DEFUN |parseEquivalence| (#0=#:G167112) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CADR #0#)) (|parseIf| (CONS |a| (CONS |b| (CONS (|parseIf| (CONS |b| (QUOTE (|false| |true|)))) NIL)))))))) ; ;parseImplies [a,b] == parseIf [a,b,'true] @@ -2094,21 +1985,6 @@ parse (DEFUN |parseExclusiveOr| (#0=#:G167140) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CADR #0#)) (|parseIf| (CONS |a| (CONS (|parseIf| (CONS |b| (QUOTE (|false| |true|)))) (CONS |b| NIL)))))))) ; -;parseExit [a,:b] == -; -- note: I wanted to convert 1s to 0s here to facilitate indexing in -; -- comp code; unfortunately, parseTran-ning is sometimes done more -; -- than once so that the count can be decremented more than once -; a:= parseTran a -; b:= parseTran b -; b => -; null INTEGERP a => -; (MOAN('"first arg ",a,'" for exit must be integer"); ['exit,1,a]) -; ['exit,a,:b] -; ['exit,1,a] - -;;; *** |parseExit| REDEFINED - -(DEFUN |parseExit| (#0=#:G167157) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CDR #0#)) (SPADLET |a| (|parseTran| |a|)) (SPADLET |b| (|parseTran| |b|)) (COND (|b| (COND ((NULL (integerp |a|)) (MOAN "first arg " |a| " for exit must be integer") (CONS (QUOTE |exit|) (CONS 1 (CONS |a| NIL)))) ((QUOTE T) (CONS (QUOTE |exit|) (CONS |a| |b|))))) ((QUOTE T) (CONS (QUOTE |exit|) (CONS 1 (CONS |a| NIL))))))))) ;parseReturn [a,:b] == ; a:= parseTran a diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index e638ee6..d14a602 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -6787,32 +6787,32 @@ o there is some code at the end of SPECEVAL BOOT that puts "up" )) (MAKEPROP (CAR X) '|makeFunctionList| (CADR X))) (REPEAT (IN X '( - (|<=| |parseLessEqual|) - (|>| |parseGreaterThan|) - (|>=| |parseGreaterEqual|) +; (|<=| |parseLessEqual|) +; (|>| |parseGreaterThan|) +; (|>=| |parseGreaterEqual|) (|$<=| |parseDollarLessEqual|) (|$>| |parseDollarGreaterThan|) (|$>=| |parseDollarGreaterEqual|) ($^= |parseDollarNotEqual|) (^ |parseNot|) (^= |parseNotEqual|) - (\: |parseColon|) - (|::| |parseCoerce|) - (@ |parseAtSign|) +; (\: |parseColon|) +; (|::| |parseCoerce|) +; (@ |parseAtSign|) ;;These two lines were commented out in the original sources. ;;However both of these lines involved control characters that ;;latex cannot handle. control-V and control-H should be the ;;actual control characters, not the text replacement shown here. ;;(control-V |parseUpArrow|) ;;(|control-H| |parseLeftArrow|) - (|and| |parseAnd|) - (CATEGORY |parseCategory|) - (|construct| |parseConstruct|) - (DEF |parseDEF|) - (|eqv| |parseEquivalence|) - (|exit| |parseExit|) - (|has| |parseHas|) - (IF |parseIf|) +; (|and| |parseAnd|) +; (CATEGORY |parseCategory|) +; (|construct| |parseConstruct|) +; (DEF |parseDEF|) +; (|eqv| |parseEquivalence|) +; (|exit| |parseExit|) +; (|has| |parseHas|) +; (IF |parseIf|) (|implies| |parseImplies|) (IN |parseIn|) (INBY |parseInBy|)