diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 7ac8477..7c772fe 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -1328,7 +1328,7 @@ leave it alone." \usesdollar{preparse-echo}{EchoLineStack} <>= (defun preparse-echo (linelist) - (declare (special $EchoLineStack Echo-Meta)) + (declare (special $EchoLineStack Echo-Meta) (ignore linelist)) (if Echo-Meta (dolist (x (reverse $EchoLineStack)) (format out-stream "~&;~A~%" x))) @@ -1769,9 +1769,13 @@ always positioned ON the first character. \defun{postError}{postError} \calls{postError}{nequal} \calls{postError}{bumperrorcount} +\usesdollar{postError}{defOp} +% \usesdollar{postError}{InteractiveMode} original source code bug +\usesdollar{postError}{postStack} <>= (defun |postError| (msg) (let (xmsg) + (declare (special |$defOp| |$postStack|)) (bumperrorcount '|precompilation|) (setq xmsg (if (and (nequal |$defOp| '|$defOp|) (null |InteractiveMode|)) @@ -1791,7 +1795,7 @@ always positioned ON the first character. \usesdollar{postForm}{boot} <>= (defun |postForm| (u) - (let (op argl arglp z numOfArgs opp x) + (let (op argl arglp numOfArgs opp x) (declare (special $boot)) (seq (setq op (car u)) @@ -1844,40 +1848,327 @@ The functions in this section are called through the symbol-plist of the symbol being parsed. The original list read: \begin{verbatim} - |add| |postAdd| - @ |postAtSign| - |:BF:| |postBigFloat| - |Block| |postBlock| - CATEGORY |postCategory| - COLLECT |postCollect| - \: |postColon| - |::| |postColonColon| - \, |postComma| - |construct| |postConstruct| - == |postDef| - |=>| |postExit| - |if| |postIf| - |in| |postin| ;" the infix operator version of in" - IN |postIn| ;" the iterator form of in" - |Join| |postJoin| - |->| |postMapping| - |==>| |postMDef| - |pretend| |postPretend| - QUOTE |postQUOTE| - |Reduce| |postReduce| - REPEAT |postRepeat| - |Scripts| |postScripts| - \; |postSemiColon| - |Signature| |postSignature| - / |postSlash| - |@Tuple| |postTuple| - |TupleCollect| |postTupleCollect| - |where| |postWhere| - |with| |postWith| + add postAdd + @ postAtSign + :BF: postBigFloat + Block postBlock + CATEGORY postCategory + COLLECT postCollect + : postColon + :: postColonColon + , postComma + construct postConstruct + == postDef + => postExit + if postIf + in postin ;" the infix operator version of in" + IN postIn ;" the iterator form of in" + Join postJoin + -> postMapping + ==> postMDef + pretend postPretend + QUOTE postQUOTE + Reduce postReduce + REPEAT postRepeat + Scripts postScripts + ; postSemiColon + Signature postSignature + / postSlash + @Tuple postTuple + TupleCollect postTupleCollect + where postWhere + with postWith \end{verbatim} @ +\defplist{add}{postAdd} +<>= +(eval-when (eval load) + (setf (get '|add| '|postTran|) '|postAdd|)) + +@ + +\defun{postAdd}{postAdd} +\calls{postAdd}{postTran} +\calls{postAdd}{postCapsule} +<>= +(defun |postAdd| (arg) + (if (null (cddr arg)) + (|postCapsule| (second arg)) + (list '|add| (|postTran| (second arg)) (|postCapsule| (third arg))))) + +@ + +\defplist{@}{postAtSign} +<>= +(eval-when (eval load) + (setf (get '@ '|postTran|) '|postAtSign|)) + +@ + +\defun{postAtSign}{postAtSign} +\calls{postAtSign}{postTran} +\calls{postAtSign}{postType} +<>= +(defun |postAtSign| (arg) + (cons '@ (cons (|postTran| (second arg)) (|postType| (third arg))))) + +@ + +\defplist{:BF:}{postBigFloat} +<>= +(eval-when (eval load) + (setf (get '|:BF:| '|postTran|) '|postBigFloat|)) + +@ + +\defun{postBigFloat}{postBigFloat} +\calls{postBigFloat}{postTran} +\usesdollar{postBigFloat}{boot} +\usesdollar{postBigFloat}{InteractiveMode} +<>= +(defun |postBigFloat| (arg) + (let (mant expon eltword) + (declare (special $boot |$InteractiveMode|)) + (setq mant (second arg)) + (setq expon (cddr arg)) + (if $boot + (times (float mant) (expt (float 10) expon)) + (progn + (setq eltword (if |$InteractiveMode| '|$elt| '|elt|)) + (|postTran| + (list (list eltword '(|Float|) '|float|) + (list '|,| (list '|,| mant expon) 10))))))) + +@ + +\defplist{Block}{postBlock} +<>= +(eval-when (eval load) + (setf (get '|Block| '|postTran|) '|postBlock|)) + +@ + +\defun{postBlock}{postBlock} +\calls{postBlock}{postBlockItemList} +\calls{postBlock}{postTran} +<>= +(defun |postBlock| (arg) + (let (tmp1 x y) + (setq tmp1 (reverse (cdr arg))) + (setq x (car tmp1)) + (setq y (nreverse (cdr tmp1))) + (cons 'seq + (append (|postBlockItemList| y) (list (list '|exit| (|postTran| x))))))) + +@ + +\defplist{category}{postCategory} +<>= +(eval-when (eval load) + (setf (get 'category '|postTran|) '|postCategory|)) + +@ + +\defun{postCategory}{postCategory} +\calls{postCategory}{postTran} +\calls{postCategory}{nreverse0} +\usesdollar{postCategory}{insidePostCategoryIfTrue} +<>= +(defun |postCategory| (u) + (labels ( + (fn (arg) + (let (|$insidePostCategoryIfTrue|) + (declare (special |$insidePostCategoryIfTrue|)) + (setq |$insidePostCategoryIfTrue| t) + (|postTran| arg))) ) + (let ((z (cdr u)) op tmp1) + (if (null z) + u + (progn + (setq op (if |$insidePostCategoryIfTrue| 'progn 'category)) + (cons op + (dolist (x z (nreverse0 tmp1)) + (push (fn |x|) tmp1)))))))) + +@ + +\defun{postCollect,finish}{postCollect,finish} +<>= +(defun |postCollect,finish| (op itl y) + (let (tmp2 tmp5 newBody) + (cond + ((and (pairp y) (eq (qcar y) '|:|) + (pairp (qcdr y)) (eq (qcdr (qcdr y)) nil)) + (list 'reduce '|append| 0 (cons op (append itl (list (qcar (qcdr y))))))) + ((and (pairp y) (eq (qcar y) '|Tuple|)) + (setq newBody + (cond + ((dolist (x (qcdr y) tmp2) + (setq tmp2 + (or tmp2 (and (pairp x) (eq (qcar x) '|:|) + (pairp (qcdr x)) (eq (qcdr (qcdr x)) nil))))) + (|postMakeCons| (qcdr y))) + ((dolist (x (qcdr y) tmp5) + (setq tmp5 (or tmp5 (and (pairp x) (eq (qcar x) 'segment))))) + (|tuple2List| (qcdr y))) + (t (cons '|construct| (|postTranList| l))))) + (list 'reduce '|append| 0 (cons op (append itl (list newBody))))) + (t (cons op (append itl (list y))))))) + +@ + +\defplist{collect}{postCollect} +<>= +(eval-when (eval load) + (setf (get 'collect '|postTran|) '|postCollect|)) + +@ + +\defun{postCollect}{postCollect} +\calls{postCollect}{postCollect,finish} +\calls{postCollect}{postCollect} +\calls{postCollect}{postIteratorList} +\calls{postCollect}{postTran} +<>= +(defun |postCollect| (arg) + (let (constructOp tmp3 m d itl x) + (setq constructOp (car arg)) + (setq tmp3 (reverse (cdr arg))) + (setq x (car tmp3)) + (setq m (nreverse (cdr tmp3))) + (cond + ((and (pairp x) (pairp (qcar x)) (eq (qcar (qcar x)) '|elt|) + (pairp (qcdr (qcar x))) (pairp (qcdr (qcdr (qcar x)))) + (eq (qcdr (qcdr (qcdr (qcar x)))) nil) + (eq (qcar (qcdr (qcdr (qcar x)))) '|construct|)) + (|postCollect| + (cons (list '|elt| (qcar (qcdr (qcar x))) 'collect) + (append m (list (cons '|construct| (qcdr x))))))) + (t + (setq itl (|postIteratorList| m)) + (setq x + (if (and (pairp x) (eq (qcar x) '|construct|) + (pairp (qcdr x)) (eq (qcdr (qcdr x)) nil)) + (qcar (qcdr x)) + x)) + (|postCollect,finish| constructOp itl (|postTran| x)))))) + +@ + +\defplist{:}{postColon} +<>= +(eval-when (eval load) + (setf (get '|:| '|postTran|) '|postColon|)) + +@ + +\defun{postColon}{postColon} +\calls{postColon}{postTran} +\calls{postColon}{postType} +<>= +(defun |postColon| (u) + (cond + ((and (pairp u) (eq (qcar u) '|:|) + (pairp (qcdr u)) (eq (qcdr (qcdr u)) nil)) + (list '|:| (|postTran| (qcar (qcdr u))))) + ((and (pairp u) (eq (qcar u) '|:|) (pairp (qcdr u)) + (pairp (qcdr (qcdr u))) (eq (qcdr (qcdr (qcdr u))) nil)) + (cons '|:| (cons (|postTran| (second u)) (|postType| (third u))))))) + +@ + +\defplist{::}{postColonColon} +<>= +(eval-when (eval load) + (setf (get '|::| '|postTran|) '|postColonColon|)) + +@ + +\defun{postColonColon}{postColonColon} +\calls{postColonColon}{stringimage} +\calls{postColonColon}{postForm} +\usesdollar{postColonColon}{boot} +<>= +(defun |postColonColon| (u) + (if (and $boot (pairp u) (eq (qcar u) '|::|) (pairp (qcdr u)) + (pairp (qcdr (qcdr u))) (eq (qcdr (qcdr (qcdr u))) nil)) + (intern (stringimage (third u)) (second u)) + (|postForm| u))) + +@ + +\defplist{,}{postComma} +<>= +(eval-when (eval load) + (setf (get '|,| '|postTran|) '|postComma|)) + +@ + +\defun{postComma}{postComma} +\calls{postComma}{postTuple} +\calls{postComma}{comma2Tuple} +<>= +(defun |postComma| (u) + (|postTuple| (|comma2Tuple| u))) + +@ + +\defun{comma2Tuple}{comma2Tuple} +\calls{comma2Tuple}{postFlatten} +<>= +(defun |comma2Tuple| (u) + (cons '|@Tuple| (|postFlatten| u '|,|))) + +@ + +\defplist{construct}{postConstruct} +<>= +(eval-when (eval load) + (setf (get '|construct| '|postTran|) '|postConstruct|)) + +@ + +\defun{postConstruct}{postConstruct} +\calls{postConstruct}{comma2Tuple} +\calls{postConstruct}{postTranSegment} +\calls{postConstruct}{postMakeCons} +\calls{postConstruct}{tuple2List} +\calls{postConstruct}{postTranList} +\calls{postConstruct}{postTran} +<>= +(defun |postConstruct| (u) + (let (b a tmp4 tmp7) + (cond + ((and (pairp u) (eq (qcar u) '|construct|) + (pairp (qcdr u)) (eq (qcdr (qcdr u)) nil)) + (setq b (qcar (qcdr u))) + (setq a + (if (and (pairp b) (eq (qcar b) '|,|)) + (|comma2Tuple| b) + b)) + (cond + ((and (pairp a) (eq (qcar a) 'segment) (pairp (qcdr a)) + (pairp (qcdr (qcdr a))) (eq (qcdr (qcdr (qcdr a))) nil)) + (list '|construct| (|postTranSegment| (second a) (third a)))) + ((and (pairp a) (eq (qcar a) '|@Tuple|)) + (cond + ((dolist (x (qcdr a) tmp4) + (setq tmp4 + (or tmp4 + (and (pairp x) (eq (qcar x) '|:|) + (pairp (qcdr x)) (eq (qcdr (qcdr x)) nil))))) + (|postMakeCons| (qcdr a))) + ((dolist (x (qcdr a) tmp7) + (setq tmp7 (or tmp7 (and (pairp x) (eq (qcar x) 'segment))))) + (|tuple2List| (qcdr a))) + (t (cons '|construct| (|postTranList| (qcdr a)))))) + (t (list '|construct| (|postTran| a))))) + (t u)))) + +@ + \defplist{with}{postWith} <>= (eval-when (eval load) @@ -1910,7 +2201,7 @@ of the symbol being parsed. The original list read: \usesdollar{setDefOp}{topOp} <>= (defun |setDefOp| (f) - (let (tmp1 g) + (let (tmp1) (declare (special |$defOp| |$topOp|)) (when (and (pairp f) (eq (qcar f) '|:|) (pairp (setq tmp1 (qcdr f)))) @@ -2381,7 +2672,7 @@ nothing (see boot2Lisp) yet still allow function call (lisp2BootAndComp). (|defLetForm| lhs rhs)) ((and (pairp lhs) (equal (qcar lhs) $let) (pairp (qcdr lhs)) (pairp (qcdr (qcdr lhs))) - (eq (qcdr (qcdr (qcdr lhs))))) + (eq (qcdr (qcdr (qcdr lhs))) nil)) (setq a (|defLET2| (qcar (qcdr lhs)) rhs)) (setq b (qcar (qcdr (qcdr lhs)))) (cond @@ -3036,7 +3327,7 @@ It is pretty much just a translation of DEF-IS-REV <>= (defun def-inner (form signature $body) "Same as DEF but assumes body has already been DEFTRANned" - (declare (special $body)) + (declare (special $body) (ignore signature)) (let ($OpAssoc ($op (first form)) (argl (rest form))) (declare (special $OpAssoc $op)) (let* ((argl (def-insert-let argl)) @@ -5745,7 +6036,7 @@ This function simply calls {\bf \verb|/rf-1|}. \usesdollar{/RQ,LIB}{lisplib} <>= (defun |/RQ,LIB| (&rest foo &aux (echo-meta nil) ($lisplib t)) - (declare (special echo-meta $lisplib)) + (declare (special echo-meta $lisplib) (ignore foo)) (/rf-1 nil)) @ @@ -6329,6 +6620,7 @@ And the {\bf s-process} function which returns a parsed version of the input. \usesdollar{s-process}{VariableCount} \usesdollar{s-process}{previousTime} \usesdollar{s-process}{LocalFrame} +\usesdollar{s-process}{Translation} \uses{s-process}{curoutstream} <>= (defun s-process (x) @@ -6367,7 +6659,7 @@ And the {\bf s-process} function which returns a parsed version of the input. |$insideCategoryIfTrue| |$insideCapsuleFunctionIfTrue| |$form| |$DomainFrame| |$e| |$EmptyEnvironment| |$genFVar| |$genSDVar| |$VariableCount| |$previousTime| |$LocalFrame| - curstrm |$s| |$x| |$m| curoutstream $traceflag)) + curstrm |$s| |$x| |$m| curoutstream $traceflag |$Translation|)) (setq $traceflag t) (if (not x) (return nil)) (if $boot @@ -8316,6 +8608,7 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> +<> <> <> <> @@ -8518,8 +8811,19 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> <> +<> +<> +<> +<> <> +<> +<> +<> +<> +<> +<> <> <> <> diff --git a/changelog b/changelog index b68ca45..71e17f0 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,8 @@ +20101025 tpd src/axiom-website/patches.html 20101025.01.tpd.patch +20101025 tpd src/interp/vmlisp.lisp treeshake compiler +20101025 tpd src/interp/parsing.lisp treeshake compiler +20101025 tpd src/interp/interp-proclaims.lisp treeshake compiler +20101025 tpd books/bookvol9 treeshake compiler 20101024 tpd src/axiom-website/patches.html 20101024.04.tpd.patch 20101024 tpd src/algebra/Makefile automate making input files 20101024 tpd books/tangle.lisp automate making input files diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 13f65cd..b7d7cc3 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3250,5 +3250,7 @@ books/bookvol9 treeshake compiler
books/tangle.lisp automate making help files
20101024.04.tpd.patch books/tangle.lisp automate making input files
+20101025.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/interp-proclaims.lisp b/src/interp/interp-proclaims.lisp index c357db0..ba86973 100644 --- a/src/interp/interp-proclaims.lisp +++ b/src/interp/interp-proclaims.lisp @@ -530,7 +530,7 @@ BOOT::|rootApp| BOOT::|bracketApp| BOOT::|plusApp| BOOT::|appparu1| BOOT::|bigopWidth| BOOT::|P2Us| BOOT::|pi2App| BOOT::|boxLApp| BOOT::STRPOSL - BOOT::|compOrCroak1| BOOT::|piApp| BOOT::|compForm2| + BOOT::|piApp| BOOT::|compForm2| BOOT::|compForm3| BOOT::|getConditionalCategoryOfType1| BOOT::|indefIntegralApp| BOOT::|nothingApp| BOOT::|evalconstruct| BOOT::|evalInfiniteTupleConstruct| diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index 5f4d0f1..b023645 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -2331,22 +2331,6 @@ parse (DEFUN |displayPreCompilationErrors| NIL (PROG (|n| |errors| |heading|) (RETURN (SEQ (PROGN (SPADLET |n| (|#| (SPADLET |$postStack| (REMDUP (NREVERSE |$postStack|))))) (COND ((EQL |n| 0) NIL) ((QUOTE T) (SPADLET |errors| (COND ((> |n| 1) "errors") ((QUOTE T) "error"))) (COND (|$InteractiveMode| (|sayBrightly| (CONS " Semantic " (CONS |errors| (CONS " detected: " NIL))))) ((QUOTE T) (SPADLET |heading| (COND ((NEQUAL |$topOp| (QUOTE |$topOp|)) (CONS " " (CONS |$topOp| (CONS " has" NIL)))) ((QUOTE T) (CONS " You have" NIL)))) (|sayBrightly| (APPEND |heading| (CONS (QUOTE |%b|) (CONS |n| (CONS (QUOTE |%d|) (CONS "precompilation " (CONS |errors| (CONS ":" NIL)))))))))) (COND ((> |n| 1) (DO ((#0=#:G166154 |$postStack| (CDR #0#)) (|x| NIL) (|i| 1 (QSADD1 |i|))) ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (|sayMath| (CONS " " (CONS |i| (CONS ") " |x|)))))))) ((QUOTE T) (|sayMath| (CONS " " (CAR |$postStack|))))) (TERPRI)))))))) -;postBigFloat x == -; [.,mant,:expon] := x -; $BOOT => INT2RNUM(mant) * INT2RNUM(10) ** expon -; eltword := if $InteractiveMode then "$elt" else 'elt -; postTran [[eltword,'(Float),'float],[",",[",",mant,expon],10]] - -;;; *** |postBigFloat| REDEFINED - -(DEFUN |postBigFloat| (|x|) (PROG (|mant| |expon| |eltword|) (RETURN (PROGN (SPADLET |mant| (CADR |x|)) (SPADLET |expon| (CDDR |x|)) (COND ($BOOT (TIMES (float |mant|) (EXPT (float 10) |expon|))) ((QUOTE T) (SPADLET |eltword| (COND (|$InteractiveMode| (QUOTE |$elt|)) ((QUOTE T) (QUOTE |elt|)))) (|postTran| (CONS (CONS |eltword| (CONS (QUOTE (|Float|)) (CONS (QUOTE |float|) NIL))) (CONS (CONS (QUOTE |,|) (CONS (CONS (QUOTE |,|) (CONS |mant| (CONS |expon| NIL))) (CONS 10 NIL))) NIL))))))))) -;postAdd ['add,a,:b] == -; null b => postCapsule a -; ['add,postTran a,postCapsule first b] - -;;; *** |postAdd| REDEFINED - -(DEFUN |postAdd| (#0=#:G166238) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |b| (CDDR #0#)) (COND ((NULL |b|) (|postCapsule| |a|)) ((QUOTE T) (CONS (QUOTE |add|) (CONS (|postTran| |a|) (CONS (|postCapsule| (CAR |b|)) NIL))))))))) ;checkWarning msg == postError concat('"Parsing error: ",msg) ;;; *** |checkWarning| REDEFINED @@ -2374,47 +2358,11 @@ parse ;;; *** |postQUOTE| REDEFINED (DEFUN |postQUOTE| (|x|) |x|) -;postColon u == -; u is [":",x] => [":",postTran x] -; u is [":",x,y] => [":",postTran x,:postType y] - -;;; *** |postColon| REDEFINED - -(DEFUN |postColon| (|u|) (PROG (|ISTMP#1| |x| |ISTMP#2| |y|) (RETURN (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (QUOTE T))))) (CONS (QUOTE |:|) (CONS (|postTran| |x|) NIL))) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |:|)) (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))))))) (CONS (QUOTE |:|) (CONS (|postTran| |x|) (|postType| |y|)))))))) -;postColonColon u == -; -- for Lisp package calling -; -- boot syntax is package::fun but probably need to parenthesize it -; $BOOT and u is ["::",package,fun] => -; INTERN(STRINGIMAGE fun, package) -; postForm u - -;;; *** |postColonColon| REDEFINED - -(DEFUN |postColonColon| (|u|) (PROG (|ISTMP#1| |package| |ISTMP#2| |fun|) (RETURN (COND ((AND $BOOT (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |::|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |package| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |fun| (QCAR |ISTMP#2|)) (QUOTE T))))))) (INTERN (STRINGIMAGE |fun|) |package|)) ((QUOTE T) (|postForm| |u|)))))) -;postAtSign ["@",x,y] == ["@",postTran x,:postType y] - -;;; *** |postAtSign| REDEFINED - -(DEFUN |postAtSign| (#0=#:G166320) (PROG (|x| |y|) (RETURN (PROGN (COND ((EQ (CAR #0#) (QUOTE @)) (CAR #0#))) (SPADLET |x| (CADR #0#)) (SPADLET |y| (CADDR #0#)) (CONS (QUOTE @) (CONS (|postTran| |x|) (|postType| |y|))))))) ;postPretend ['pretend,x,y] == ['pretend,postTran x,:postType y] ;;; *** |postPretend| REDEFINED (DEFUN |postPretend| (#0=#:G166336) (PROG (|x| |y|) (RETURN (PROGN (SPADLET |x| (CADR #0#)) (SPADLET |y| (CADDR #0#)) (CONS (QUOTE |pretend|) (CONS (|postTran| |x|) (|postType| |y|))))))) -;postConstruct u == -; u is ['construct,b] => -; a:= (b is [",",:.] => comma2Tuple b; b) -; a is ['SEGMENT,p,q] => ['construct,postTranSegment(p,q)] -; a is ['Tuple,:l] => -; or/[x is [":",y] for x in l] => postMakeCons l -; or/[x is ['SEGMENT,:.] for x in l] => tuple2List l -; ['construct,:postTranList l] -; ['construct,postTran a] -; u - -;;; *** |postConstruct| REDEFINED - -(DEFUN |postConstruct| (|u|) (PROG (|b| |a| |p| |ISTMP#2| |q| |l| |ISTMP#1| |y|) (RETURN (SEQ (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |construct|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#1|)) (QUOTE T))))) (SPADLET |a| (COND ((AND (PAIRP |b|) (EQ (QCAR |b|) (QUOTE |,|))) (|comma2Tuple| |b|)) ((QUOTE T) |b|))) (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |a|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |q| (QCAR |ISTMP#2|)) (QUOTE T))))))) (CONS (QUOTE |construct|) (CONS (|postTranSegment| |p| |q|) NIL))) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |@Tuple|)) (PROGN (SPADLET |l| (QCDR |a|)) (QUOTE T))) (COND ((PROG (#0=#:G166378) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166388 NIL #0#) (#2=#:G166389 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (OR #0# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T)))))))))))) (|postMakeCons| |l|)) ((PROG (#3=#:G166396) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G166402 NIL #3#) (#5=#:G166403 |l| (CDR #5#)) (|x| NIL)) ((OR #4# (ATOM #5#) (PROGN (SETQ |x| (CAR #5#)) NIL)) #3#) (SEQ (EXIT (SETQ #3# (OR #3# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE SEGMENT)))))))))) (|tuple2List| |l|)) ((QUOTE T) (CONS (QUOTE |construct|) (|postTranList| |l|))))) ((QUOTE T) (CONS (QUOTE |construct|) (CONS (|postTran| |a|) NIL))))) ((QUOTE T) |u|)))))) ;postMakeCons l == ; null l => 'nil ; l is [[":",a],:l'] => @@ -2463,16 +2411,6 @@ parse ;;; *** |postCategory| REDEFINED (DEFUN |postCategory| (|u|) (PROG (|l| |op|) (RETURN (SEQ (PROGN (SPADLET |l| (CDR |u|)) (COND ((NULL |l|) |u|) ((QUOTE T) (SPADLET |op| (COND ((BOOT-EQUAL |$insidePostCategoryIfTrue| (QUOTE T)) (QUOTE PROGN)) ((QUOTE T) (QUOTE CATEGORY)))) (CONS |op| (PROG (#0=#:G166582) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166587 |l| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|postCategory,fn| |x|) #0#))))))))))))))) -;postComma u == postTuple comma2Tuple u - -;;; *** |postComma| REDEFINED - -(DEFUN |postComma| (|u|) (|postTuple| (|comma2Tuple| |u|))) -;comma2Tuple u == ['Tuple,:postFlatten(u,",")] - -;;; *** |comma2Tuple| REDEFINED - -(DEFUN |comma2Tuple| (|u|) (CONS (QUOTE |@Tuple|) (|postFlatten| |u| (QUOTE |,|)))) ;postDef [defOp,lhs,rhs] == ;--+ ; lhs is ["macro",name] => postMDef ["==>",name,rhs] @@ -2646,13 +2584,6 @@ parse ; ['REDUCE,'append,0,[op,:itl,newBody]] ; [op,:itl,y] -;;; *** |postCollect,finish| REDEFINED - -(DEFUN |postCollect,finish| (|op| |itl| |y|) (PROG (|a| |l| |ISTMP#1| |newBody|) (RETURN (SEQ (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |y|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (QUOTE T))))) (EXIT (CONS (QUOTE REDUCE) (CONS (QUOTE |append|) (CONS 0 (CONS (CONS |op| (APPEND |itl| (CONS |a| NIL))) NIL)))))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |@Tuple|)) (PROGN (SPADLET |l| (QCDR |y|)) (QUOTE T))) (EXIT (SEQ (SPADLET |newBody| (SEQ (IF (PROG (#0=#:G167314) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G167324 NIL #0#) (#2=#:G167325 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (OR #0# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T)))))))))))) (EXIT (|postMakeCons| |l|))) (IF (PROG (#3=#:G167332) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G167338 NIL #3#) (#5=#:G167339 |l| (CDR #5#)) (|x| NIL)) ((OR #4# (ATOM #5#) (PROGN (SETQ |x| (CAR #5#)) NIL)) #3#) (SEQ (EXIT (SETQ #3# (OR #3# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE SEGMENT)))))))))) (EXIT (|tuple2List| |l|))) (EXIT (CONS (QUOTE |construct|) (|postTranList| |l|))))) (EXIT (CONS (QUOTE REDUCE) (CONS (QUOTE |append|) (CONS 0 (CONS (CONS |op| (APPEND |itl| (CONS |newBody| NIL))) NIL)))))))) (EXIT (CONS |op| (APPEND |itl| (CONS |y| NIL)))))))) - -;;; *** |postCollect| REDEFINED - -(DEFUN |postCollect| (#0=#:G167359) (PROG (|constructOp| |LETTMP#1| |m| |ISTMP#2| D |ISTMP#3| |itl| |ISTMP#1| |r| |x| |y|) (RETURN (PROGN (SPADLET |constructOp| (CAR #0#)) (SPADLET |LETTMP#1| (REVERSE (CDR #0#))) (SPADLET |x| (CAR |LETTMP#1|)) (SPADLET |m| (NREVERSE (CDR |LETTMP#1|))) (COND ((AND (PAIRP |x|) (PROGN (SPADLET |ISTMP#1| (QCAR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |elt|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET D (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (EQ (QCAR |ISTMP#3|) (QUOTE |construct|)))))))) (PROGN (SPADLET |y| (QCDR |x|)) (QUOTE T))) (|postCollect| (CONS (CONS (QUOTE |elt|) (CONS D (CONS (QUOTE COLLECT) NIL))) (APPEND |m| (CONS (CONS (QUOTE |construct|) |y|) NIL))))) ((QUOTE T) (SPADLET |itl| (|postIteratorList| |m|)) (SPADLET |x| (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |construct|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |r| (QCAR |ISTMP#1|)) (QUOTE T))))) |r|) ((QUOTE T) |x|))) (SPADLET |y| (|postTran| |x|)) (|postCollect,finish| |constructOp| |itl| |y|))))))) ;postTupleCollect [constructOp,:m,x] == ; postCollect [constructOp,:m,['construct,x]] diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index 5204e4c..4a29fdf 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -6838,28 +6838,28 @@ o there is some code at the end of SPECEVAL BOOT that puts "up" ; (|with| |postWith|) (|Scripts| |postScripts|) (/ |postSlash|) - (|construct| |postConstruct|) - (|Block| |postBlock|) +; (|construct| |postConstruct|) +; (|Block| |postBlock|) (QUOTE |postQUOTE|) - (COLLECT |postCollect|) - (|:BF:| |postBigFloat|) +; (COLLECT |postCollect|) +; (|:BF:| |postBigFloat|) (|in| |postin|) ;" the infix operator version of in" (IN |postIn|) ;" the iterator form of in" (REPEAT |postRepeat|) (|TupleCollect| |postTupleCollect|) - (|add| |postAdd|) +; (|add| |postAdd|) (|Reduce| |postReduce|) - (\, |postComma|) +; (\, |postComma|) (\; |postSemiColon|) (|where| |postWhere|) - (|::| |postColonColon|) - (\: |postColon|) - (@ |postAtSign|) +; (|::| |postColonColon|) +; (\: |postColon|) +; (@ |postAtSign|) (|pretend| |postPretend|) (|if| |postIf|) (|Join| |postJoin|) (|Signature| |postSignature|) - (CATEGORY |postCategory|) +; (CATEGORY |postCategory|) ;;( |postDef|) (== |postDef|) (|==>| |postMDef|)