diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 347b436..6349513 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -5460,10 +5460,10 @@ and the current token (\$ttok) \section{Leaves} \defun{pfIdSymbol}{Return the Id part} -\calls{pfIdSymbol}{} +\calls{pfIdSymbol}{tokPart} <>= -(defun |pfIdSymbol| (|form|) - (|tokPart| |form|)) +(defun |pfIdSymbol| (form) + (|tokPart| form)) @ @@ -5502,6 +5502,37 @@ and the current token (\$ttok) @ +\defun{pfAssign?}{Is this an Assign node?} +\calls{pfAssign?}{pfAbSynOp?} +<>= +(defun |pfAssign?| (pf) + (|pfAbSynOp?| pf '|Assign|)) + +@ + +\defun{pf0AssignLhsItems}{Return the parts of an LhsItem of an Assign node} +\calls{pf0AssignLhsItems}{pfParts} +\calls{pf0AssignLhsItems}{pfAssignLhsItems} +<>= +(defun |pf0AssignLhsItems| (pf) + (|pfParts| (|pfAssignLhsItems| pf))) + +@ + +\defun{pfAssignLhsItems}{Return the LhsItem of an Assign node} +<>= +(defun |pfAssignLhsItems| (pf) + (cadr pf)) + +@ + +\defun{pfAssignRhs}{Return the RHS of an Assign node} +<>= +(defun |pfAssignRhs| (pf) + (caddr pf)) + +@ + \defun{pfCoerceto?}{Is this a CoerceTo node?} \calls{pfCoerceto?}{pfAbSynOp?} <>= @@ -5524,6 +5555,90 @@ and the current token (\$ttok) @ +\defun{pfCollect?}{Is this a Collect node?} +\calls{pfCollect?}{pfAbSynOp?} +<>= +(defun |pfCollect?| (pf) + (|pfAbSynOp?| pf '|Collect|)) + +@ + +\defun{pfDefinition?}{Is this a Definition node?} +\calls{pfDefinition?}{pfAbSynOp?} +<>= +(defun |pfDefinition?| (pf) + (|pfAbSynOp?| pf '|Definition|)) + +@ + +\defun{pfDo?}{Is this a Do node?} +\calls{pfDo?}{pfAbSynOp?} +<>= +(defun |pfDo?| (pf) + (|pfAbSynOp?| pf '|Do|)) + +@ + +\defun{pfDoBody}{Return the Body of a Do node} +<>= +(defun |pfDoBody| (pf) + (cadr pf)) + +@ + +\defun{pfExit?}{Is this an Exit node?} +\calls{pfExit?}{pfAbSynOp?} +<>= +(defun |pfExit?| (pf) + (|pfAbSynOp?| pf '|Exit|)) + +@ + +\defun{pfExitCond}{Return the Cond part of an Exit} +<>= +(defun |pfExitCond| (pf) + (cadr pf)) + +@ + +\defun{pfExitExpr}{Return the Expression part of an Exit} +<>= +(defun |pfExitExpr| (pf) + (caddr pf)) + +@ + +\defun{pfForin?}{Is this a ForIn node?} +\calls{pfForin?}{pfAbSynOp?} +<>= +(defun |pfForin?| (pf) + (|pfAbSynOp?| pf '|Forin|)) + +@ + +\defun{pf0ForinLhs}{Return all the parts of the LHS of a ForIn node} +\calls{pf0ForinLhs}{pfParts} +\calls{pf0ForinLhs}{pfForinLhs} +<>= +(defun |pf0ForinLhs| (pf) + (|pfParts| (|pfForinLhs| pf))) + +@ + +\defun{pfForinLhs}{Return the LHS part of a ForIn node} +<>= +(defun |pfForinLhs| (pf) + (cadr pf)) + +@ + +\defun{pfForinWhole}{Return the Whole part of a ForIn node} +<>= +(defun |pfForinWhole| (pf) + (caddr pf)) + +@ + \defun{pfFromdom?}{Is this a Fromdom mode?} \calls{pfFromdom?}{pfAbSynOp?} <>= @@ -5561,28 +5676,6 @@ and the current token (\$ttok) @ -\defun{pfExit?}{Is this an Exit node?} -\calls{pfExit?}{pfAbSynOp?} -<>= -(defun |pfExit?| (pf) - (|pfAbSynOp?| pf '|Exit|)) - -@ - -\defun{pfExitCond}{Return the Cond part of an Exit} -<>= -(defun |pfExitCond| (pf) - (cadr pf)) - -@ - -\defun{pfExitExpr}{Return the Expression part of an Exit} -<>= -(defun |pfExitExpr| (pf) - (caddr pf)) - -@ - \defun{pfIfThen}{Return the Then part of an If} <>= (defun |pfIfThen| (pf) @@ -5605,6 +5698,15 @@ and the current token (\$ttok) @ +\defun{pf0LoopIterators}{pf0LoopIterators} +\calls{pf0LoopIterators}{pfParts} +\calls{pf0LoopIterators}{pf0LoopIterators} +<>= +(defun |pf0LoopIterators| (pf) + (|pfParts| (|pfLoopIterators| pf))) + +@ + \defun{pfPretend?}{Is this a Pretend node?} \calls{pfPretend?}{pfAbSynOp?} <>= @@ -5635,6 +5737,21 @@ and the current token (\$ttok) @ +\defun{pfSuchthat?}{Is this a SuchThat node?} +\calls{pfSuchthat?}{pfAbSynOp?} +<>= +(defun |pfSuchthat?| (pf) + (|pfAbSynOp?| pf '|Suchthat|)) + +@ + +\defun{pfSuchthatCond}{Return the Cond part of a SuchThat node} +<>= +(defun |pfSuchthatCond| (pf) + (cadr pf)) + +@ + \defun{pfTagged?}{Is this a Tagged node?} \calls{pfTagged?}{pfAbSynOp?} <>= @@ -5657,6 +5774,28 @@ and the current token (\$ttok) @ +\defun{pfTyped?}{Is this a Typed node?} +\calls{pfTyped?}{pfAbSynOp?} +<>= +(defun |pfTyped?| (pf) + (|pfAbSynOp?| pf '|Typed|)) + +@ + +\defun{pfTypedType}{Return the Type of a Typed node} +<>= +(defun |pfTypedType| (pf) + (caddr pf)) + +@ + +\defun{pfTypedId}{Return the Id of a Typed node} +<>= +(defun |pfTypedId| (pf) + (cadr pf)) + +@ + \defun{pfTuple?}{Is this a Tuple node?} \calls{pfTuple?}{pfAbSynOp?} <>= @@ -5674,6 +5813,21 @@ and the current token (\$ttok) @ +\defun{pfWhile?}{Is this a While node?} +\calls{pfWhile?}{pfAbSynOp?} +<>= +(defun |pfWhile?| (pf) + (|pfAbSynOp?| pf '|While|)) + +@ + +\defun{pfWhileCond}{} +<>= +(defun |pfWhileCond| (pf) + (cadr pf)) + +@ + \chapter{Pftree to s-expression translation} Pftree to s-expression translation. Used to interface the new parser technology to the interpreter. The input is a parseTree and the @@ -5749,9 +5903,7 @@ output is an old-parser-style s-expression. \calls{pf2Sex1}{pfDoBody} \calls{pf2Sex1}{pfTyped?} \calls{pf2Sex1}{pfTypedType} -\calls{pf2Sex1}{pfNothing?} \calls{pf2Sex1}{pfTypedId} -\calls{pf2Sex1}{pfTypedType} \calls{pf2Sex1}{pfAssign?} \calls{pf2Sex1}{pf0AssignLhsItems} \calls{pf2Sex1}{pfAssignRhs} @@ -6121,257 +6273,189 @@ output is an old-parser-style s-expression. \end{verbatim} \calls{loopIters2Sex}{pf2Sex1} <>= -(DEFUN |loopIters2Sex| (|iterList|) - (PROG (|ISTMP#8| |j| |incr| |ISTMP#7| |ISTMP#6| |ISTMP#5| |i| - |ISTMP#4| |ISTMP#3| |ISTMP#2| |var| |ISTMP#1| |sex| - |result|) - (RETURN - (PROGN - (SETQ |result| NIL) - ((LAMBDA (|bfVar#27| |iter|) - (LOOP - (COND - ((OR (ATOM |bfVar#27|) - (PROGN (SETQ |iter| (CAR |bfVar#27|)) NIL)) - (RETURN NIL)) - ('T - (PROGN - (SETQ |sex| (|pf2Sex1| |iter|)) - (COND - ((AND (CONSP |sex|) (EQ (CAR |sex|) 'IN) - (PROGN - (SETQ |ISTMP#1| (CDR |sex|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |var| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (CDR |ISTMP#2|) NIL) - (PROGN - (SETQ |ISTMP#3| (CAR |ISTMP#2|)) - (AND (CONSP |ISTMP#3|) - (EQ (CAR |ISTMP#3|) 'SEGMENT) - (PROGN - (SETQ |ISTMP#4| - (CDR |ISTMP#3|)) - (AND (CONSP |ISTMP#4|) - (PROGN - (SETQ |i| (CAR |ISTMP#4|)) - (SETQ |ISTMP#5| - (CDR |ISTMP#4|)) - (AND (CONSP |ISTMP#5|) - (EQ (CDR |ISTMP#5|) NIL) - (PROGN - (SETQ |ISTMP#6| - (CAR |ISTMP#5|)) - (AND (CONSP |ISTMP#6|) - (EQ (CAR |ISTMP#6|) - 'BY) - (PROGN - (SETQ |ISTMP#7| - (CDR |ISTMP#6|)) - (AND - (CONSP |ISTMP#7|) - (EQ (CDR |ISTMP#7|) - NIL) - (PROGN - (SETQ |incr| - (CAR |ISTMP#7|)) - 'T)))))))))))))))) - (SETQ |result| - (CONS (LIST 'STEP |var| |i| |incr|) - |result|))) - ((AND (CONSP |sex|) (EQ (CAR |sex|) 'IN) - (PROGN - (SETQ |ISTMP#1| (CDR |sex|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |var| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (CDR |ISTMP#2|) NIL) - (PROGN - (SETQ |ISTMP#3| (CAR |ISTMP#2|)) - (AND (CONSP |ISTMP#3|) - (EQ (CAR |ISTMP#3|) 'BY) - (PROGN - (SETQ |ISTMP#4| - (CDR |ISTMP#3|)) - (AND (CONSP |ISTMP#4|) - (PROGN - (SETQ |ISTMP#5| - (CAR |ISTMP#4|)) - (AND (CONSP |ISTMP#5|) - (EQ (CAR |ISTMP#5|) - 'SEGMENT) - (PROGN - (SETQ |ISTMP#6| - (CDR |ISTMP#5|)) - (AND (CONSP |ISTMP#6|) - (PROGN - (SETQ |i| - (CAR |ISTMP#6|)) - (SETQ |ISTMP#7| - (CDR |ISTMP#6|)) - (AND - (CONSP |ISTMP#7|) - (EQ (CDR |ISTMP#7|) - NIL) - (PROGN - (SETQ |j| - (CAR |ISTMP#7|)) - 'T))))))) - (PROGN - (SETQ |ISTMP#8| - (CDR |ISTMP#4|)) - (AND (CONSP |ISTMP#8|) - (EQ (CDR |ISTMP#8|) NIL) - (PROGN - (SETQ |incr| - (CAR |ISTMP#8|)) - 'T)))))))))))) - (SETQ |result| - (CONS (LIST 'STEP |var| |i| |incr| |j|) - |result|))) - ((AND (CONSP |sex|) (EQ (CAR |sex|) 'IN) - (PROGN - (SETQ |ISTMP#1| (CDR |sex|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |var| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (CDR |ISTMP#2|) NIL) - (PROGN - (SETQ |ISTMP#3| (CAR |ISTMP#2|)) - (AND (CONSP |ISTMP#3|) - (EQ (CAR |ISTMP#3|) 'SEGMENT) - (PROGN - (SETQ |ISTMP#4| - (CDR |ISTMP#3|)) - (AND (CONSP |ISTMP#4|) - (PROGN - (SETQ |i| (CAR |ISTMP#4|)) - (SETQ |ISTMP#5| - (CDR |ISTMP#4|)) - (AND (CONSP |ISTMP#5|) - (EQ (CDR |ISTMP#5|) NIL) - (PROGN - (SETQ |j| - (CAR |ISTMP#5|)) - 'T)))))))))))) - (SETQ |result| - (CONS (LIST 'STEP |var| |i| 1 |j|) |result|))) - ('T (SETQ |result| (CONS |sex| |result|))))))) - (SETQ |bfVar#27| (CDR |bfVar#27|)))) - |iterList| NIL) - (NREVERSE |result|))))) -;(defun |loopIters2Sex| (iterList) -; (let (j incr i var sex result tmp1 tmp2 tmp3 tmp4 tmp5 tmp6 tmp7 tmp8) -; (dolist (iter iterList (nreverse result)) -; (setq sex (|pf2Sex1| iter)) -; (cond -; ((and (consp sex) -; (eq (car sex) 'in) -; (progn -; (setq tmp1 (cdr sex)) -; (and (consp tmp1) -; (progn -; (setq var (car tmp1)) -; (setq tmp2 (cdr tmp1)) -; (and (consp tmp2) -; (eq (cdr tmp2) nil) -; (progn -; (setq tmp3 (car tmp2)) -; (and (consp tmp3) -; (eq (car tmp3) 'segment) -; (progn -; (setq tmp4 (cdr tmp3)) -; (and (consp tmp4) -; (progn -; (setq i (car tmp4)) -; (setq tmp5 (cdr tmp4)) -; (and (consp tmp5) -; (eq (cdr tmp5) nil) -; (progn -; (setq tmp6 (car tmp5)) -; (and (consp tmp6) -; (eq (car tmp6) 'by) -; (progn -; (setq tmp7 (cdr tmp6)) -; (and (consp tmp7) -; (eq (cdr tmp7) nil) -; (progn -; (setq incr (car tmp7)) -; t)))))))))))))))) -; (setq result (cons (list 'step var i incr) result))) -; ((and (consp sex) -; (eq (car sex) 'in) -; (progn -; (setq tmp1 (cdr sex)) -; (and (consp tmp1) -; (progn -; (setq var (car tmp1)) -; (setq tmp2 (cdr tmp1)) -; (and (consp tmp2) -; (eq (cdr tmp2) nil) -; (progn -; (setq tmp3 (car tmp2)) -; (and (consp tmp3) -; (eq (car tmp3) 'by) -; (progn -; (setq tmp4 (cdr tmp3)) -; (and (consp tmp4) -; (progn -; (setq tmp5 (car tmp4)) -; (and (consp tmp5) -; (eq (car tmp5) 'segment) -; (progn -; (setq tmp6 (cdr tmp5)) -; (and (consp tmp6) -; (progn -; (setq i (car tmp6)) -; (setq tmp7 (cdr tmp6)) -; (and (consp tmp7) -; (eq (cdr tmp7) nil) -; (progn -; (setq j (car tmp7)) -; t))))))) -; (progn -; (setq tmp8 (cdr tmp4)) -; (and (consp tmp8) -; (eq (cdr tmp8) nil) -; (progn -; (setq incr (car tmp8)) -; t)))))))))))) -; (setq result (cons (list 'step var i incr j) result))) -; ((and (consp sex) -; (eq (car sex) 'in) -; (progn -; (setq tmp1 (cdr sex)) -; (and (consp tmp1) -; (progn -; (setq var (car tmp1)) -; (setq tmp2 (cdr tmp1)) -; (and (consp tmp2) -; (eq (cdr tmp2) nil) -; (progn -; (setq tmp3 (car tmp2)) -; (and (consp tmp3) -; (eq (car tmp3) 'segment) -; (progn -; (setq tmp4 (cdr tmp3)) -; (and (consp tmp4) -; (progn -; (setq i (car tmp4)) -; (setq tmp5 (cdr tmp4)) -; (and (consp tmp5) -; (eq (cdr tmp5) nil) -; (progn -; (setq j (car tmp5)) -; t)))))))))))) -; (setq result (cons (list 'step var i 1 j) result))) -; (t (setq result (cons sex result))))))) +(defun |loopIters2Sex| (iterList) + (let (j incr i var sex result tmp1 tmp2 tmp3 tmp4 tmp5 tmp6 tmp7 tmp8) + (dolist (iter iterList (nreverse result)) + (setq sex (|pf2Sex1| iter)) + (cond + ((and (consp sex) + (eq (car sex) 'in) + (progn + (setq tmp1 (cdr sex)) + (and (consp tmp1) + (progn + (setq var (car tmp1)) + (setq tmp2 (cdr tmp1)) + (and (consp tmp2) + (eq (cdr tmp2) nil) + (progn + (setq tmp3 (car tmp2)) + (and (consp tmp3) + (eq (car tmp3) 'segment) + (progn + (setq tmp4 (cdr tmp3)) + (and (consp tmp4) + (progn + (setq i (car tmp4)) + (setq tmp5 (cdr tmp4)) + (and (consp tmp5) + (eq (cdr tmp5) nil) + (progn + (setq tmp6 (car tmp5)) + (and (consp tmp6) + (eq (car tmp6) 'by) + (progn + (setq tmp7 (cdr tmp6)) + (and (consp tmp7) + (eq (cdr tmp7) nil) + (progn + (setq incr (car tmp7)) + t)))))))))))))))) + (setq result (cons (list 'step var i incr) result))) + ((and (consp sex) + (eq (car sex) 'in) + (progn + (setq tmp1 (cdr sex)) + (and (consp tmp1) + (progn + (setq var (car tmp1)) + (setq tmp2 (cdr tmp1)) + (and (consp tmp2) + (eq (cdr tmp2) nil) + (progn + (setq tmp3 (car tmp2)) + (and (consp tmp3) + (eq (car tmp3) 'by) + (progn + (setq tmp4 (cdr tmp3)) + (and (consp tmp4) + (progn + (setq tmp5 (car tmp4)) + (and (consp tmp5) + (eq (car tmp5) 'segment) + (progn + (setq tmp6 (cdr tmp5)) + (and (consp tmp6) + (progn + (setq i (car tmp6)) + (setq tmp7 (cdr tmp6)) + (and (consp tmp7) + (eq (cdr tmp7) nil) + (progn + (setq j (car tmp7)) + t))))))) + (progn + (setq tmp8 (cdr tmp4)) + (and (consp tmp8) + (eq (cdr tmp8) nil) + (progn + (setq incr (car tmp8)) + t)))))))))))) + (setq result (cons (list 'step var i incr j) result))) + ((and (consp sex) + (eq (car sex) 'in) + (progn + (setq tmp1 (cdr sex)) + (and (consp tmp1) + (progn + (setq var (car tmp1)) + (setq tmp2 (cdr tmp1)) + (and (consp tmp2) + (eq (cdr tmp2) nil) + (progn + (setq tmp3 (car tmp2)) + (and (consp tmp3) + (eq (car tmp3) 'segment) + (progn + (setq tmp4 (cdr tmp3)) + (and (consp tmp4) + (progn + (setq i (car tmp4)) + (setq tmp5 (cdr tmp4)) + (and (consp tmp5) + (eq (cdr tmp5) nil) + (progn + (setq j (car tmp5)) + t)))))))))))) + (setq result (cons (list 'step var i 1 j) result))) + (t (setq result (cons sex result))))))) + +@ + +\defun{pfCollect2Sex}{Change a Collect node to an S-expression} +\calls{pfCollect2Sex}{loopIters2Sex} +\calls{pfCollect2Sex}{pfParts} +\calls{pfCollect2Sex}{pfCollectIterators} +\calls{pfCollect2Sex}{pf2Sex1} +\calls{pfCollect2Sex}{pfCollectBody} +<>= +(defun |pfCollect2Sex| (pf) + (let (var cond sex tmp1 tmp2 tmp3 tmp4) + (setq sex + (cons 'collect + (append (|loopIters2Sex| (|pfParts| (|pfCollectIterators| pf))) + (list (|pf2Sex1| (|pfCollectBody| pf)))))) + (cond + ((and (consp sex) + (eq (car sex) 'collect) + (progn + (setq tmp1 (cdr sex)) + (and (consp tmp1) + (progn + (setq tmp2 (car tmp1)) + (and (consp tmp2) + (eq (car tmp2) '|\||) + (progn + (setq tmp3 (cdr tmp2)) + (and (consp tmp3) + (eq (cdr tmp3) nil) + (progn + (setq cond (car tmp3)) + t))))) + (progn + (setq tmp4 (cdr tmp1)) + (and (consp tmp4) + (eq (cdr tmp4) nil) + (progn (setq var (car tmp4)) t))))) + (symbolp var)) + (list '|\|| var cond)) + (t sex)))) + + +@ + +\defun{pfDefinition2Sex}{Convert a Definition node to an S-expression} +\calls{pfDefinition2Sex}{pf2Sex1} +\calls{pfDefinition2Sex}{pf0DefinitionLhsItems} +\calls{pfDefinition2Sex}{pfDefinitionRhs} +\calls{pfDefinition2Sex}{systemError} +\calls{pfDefinition2Sex}{pfLambdaTran} +\usesdollar{pfDefinition2Sex}{insideApplication} +<>= +(defun |pfDefinition2Sex| (pf) + (let (body argList tmp1 rhs id idList) + (declare (special |$insideApplication|)) + (if |$insideApplication| + (list 'optarg + (|pf2Sex1| (car (|pf0DefinitionLhsItems| pf))) + (|pf2Sex1| (|pfDefinitionRhs| pf))) + (progn + (setq idList (mapcar #'|pf2Sex1| (|pf0DefinitionLhsItems| pf))) + (if (not (eql (length idList) 1)) + (|systemError| + "lhs of definition must be a single item in the interpreter") + (progn + (setq id (car idList)) + (setq rhs (|pfDefinitionRhs| pf)) + (setq tmp1 (|pfLambdaTran| rhs)) + (setq argList (car tmp1)) + (setq body (cdr tmp1)) + (cons 'def + (cons + (if (eq argList '|id|) + id + (cons id argList)) + body)))))))) @ @@ -34045,12 +34129,24 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> +<> +<> <> <> <> +<> +<> +<> +<> +<> +<> <> <> <> +<> +<> +<> <> <> <> @@ -34072,12 +34168,22 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> +<> <> <> <> <> <> +<> +<> +<> <> +<> +<> +<> +<> +<> <> <> <> diff --git a/changelog b/changelog index e6a5f09..cc37007 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20100208 tpd src/axiom-website/patches.html 20100208.01.tpd.patch +20100208 tpd src/interp/ptrees.lisp treeshake +20100208 tpd src/interp/pf2sex.lisp treeshake +20100208 tpd books/bookvol5 treeshake ptrees, pf2sex 20100207 tpd src/axiom-website/patches.html 20100207.01.tpd.patch 20100207 tpd src/interp/ptrees.lisp treeshake 20100207 tpd src/interp/pf2sex.lisp treeshake diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 45d4281..9e37978 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2441,5 +2441,7 @@ books/bookvol5 merge and remove intint.lisp
books/bookvol5 merge and remove monitor.lisp
20100207.01.tpd.patch books/bookvol5 treeshake ptrees, pf2sex
+20100208.01.tpd.patch +books/bookvol5 treeshake ptrees, pf2sex
diff --git a/src/interp/pf2sex.lisp.pamphlet b/src/interp/pf2sex.lisp.pamphlet index 78d08fa..9605208 100644 --- a/src/interp/pf2sex.lisp.pamphlet +++ b/src/interp/pf2sex.lisp.pamphlet @@ -168,58 +168,6 @@ Value = NIL (NCONC (NREVERSE |nonOpt|) (LIST (CONS '|construct| (NREVERSE |opt|)))))))))) -;pfDefinition2Sex pf == -; $insideApplication => -; ["OPTARG", pf2Sex1 CAR pf0DefinitionLhsItems pf, -; pf2Sex1 pfDefinitionRhs pf] -; idList := [pf2Sex1 x for x in pf0DefinitionLhsItems pf] -; #idList ^= 1 => -; systemError '"lhs of definition must be a single item in the interpreter" -; id := first idList -; rhs := pfDefinitionRhs pf -; [argList, :body] := pfLambdaTran rhs -; ["DEF", (argList = 'id => id; [id, :argList]), :body] - -(DEFUN |pfDefinition2Sex| (|pf|) - (PROG (|body| |argList| |LETTMP#1| |rhs| |id| |idList|) - (DECLARE (SPECIAL |$insideApplication|)) - (RETURN - (COND - (|$insideApplication| - (LIST 'OPTARG - (|pf2Sex1| (CAR (|pf0DefinitionLhsItems| |pf|))) - (|pf2Sex1| (|pfDefinitionRhs| |pf|)))) - ('T - (PROGN - (SETQ |idList| - ((LAMBDA (|bfVar#19| |bfVar#18| |x|) - (LOOP - (COND - ((OR (ATOM |bfVar#18|) - (PROGN (SETQ |x| (CAR |bfVar#18|)) NIL)) - (RETURN (NREVERSE |bfVar#19|))) - ('T - (SETQ |bfVar#19| - (CONS (|pf2Sex1| |x|) |bfVar#19|)))) - (SETQ |bfVar#18| (CDR |bfVar#18|)))) - NIL (|pf0DefinitionLhsItems| |pf|) NIL)) - (COND - ((NOT (EQL (LENGTH |idList|) 1)) - (|systemError| - "lhs of definition must be a single item in the interpreter")) - ('T - (PROGN - (SETQ |id| (CAR |idList|)) - (SETQ |rhs| (|pfDefinitionRhs| |pf|)) - (SETQ |LETTMP#1| (|pfLambdaTran| |rhs|)) - (SETQ |argList| (CAR |LETTMP#1|)) - (SETQ |body| (CDR |LETTMP#1|)) - (CONS 'DEF - (CONS (COND - ((EQ |argList| '|id|) |id|) - ('T (CONS |id| |argList|))) - |body|))))))))))) - ;pfLambdaTran pf == ; pfLambda? pf => ; argTypeList := nil @@ -413,48 +361,6 @@ Value = NIL ('T |bfForm|)))))) -;pfCollect2Sex pf == -; sex := ["COLLECT", :loopIters2Sex pfParts pfCollectIterators pf, -; pf2Sex1 pfCollectBody pf] -; sex is ["COLLECT", ["|", cond], var] and SYMBOLP var => -; ["|", var, cond] -; sex - -(DEFUN |pfCollect2Sex| (|pf|) - (PROG (|var| |ISTMP#4| |cond| |ISTMP#3| |ISTMP#2| |ISTMP#1| |sex|) - (RETURN - (PROGN - (SETQ |sex| - (CONS 'COLLECT - (APPEND (|loopIters2Sex| - (|pfParts| (|pfCollectIterators| |pf|))) - (CONS (|pf2Sex1| (|pfCollectBody| |pf|)) - NIL)))) - (COND - ((AND (CONSP |sex|) (EQ (CAR |sex|) 'COLLECT) - (PROGN - (SETQ |ISTMP#1| (CDR |sex|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |ISTMP#2| (CAR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (CAR |ISTMP#2|) '|\||) - (PROGN - (SETQ |ISTMP#3| (CDR |ISTMP#2|)) - (AND (CONSP |ISTMP#3|) - (EQ (CDR |ISTMP#3|) NIL) - (PROGN - (SETQ |cond| (CAR |ISTMP#3|)) - 'T))))) - (PROGN - (SETQ |ISTMP#4| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#4|) - (EQ (CDR |ISTMP#4|) NIL) - (PROGN (SETQ |var| (CAR |ISTMP#4|)) 'T))))) - (SYMBOLP |var|)) - (LIST '|\|| |var| |cond|)) - ('T |sex|)))))) - ;pfRule2Sex pf == ; $quotedOpList:local := nil ; $predicateList:local := nil diff --git a/src/interp/ptrees.lisp.pamphlet b/src/interp/ptrees.lisp.pamphlet index c883fb3..cd0596c 100644 --- a/src/interp/ptrees.lisp.pamphlet +++ b/src/interp/ptrees.lisp.pamphlet @@ -739,19 +739,6 @@ (DEFUN |pfTyped| (|pfid| |pftype|) (PROG () (RETURN (|pfTree| '|Typed| (LIST |pfid| |pftype|))))) -;pfTyped?(pf) == pfAbSynOp? (pf, 'Typed) - -(DEFUN |pfTyped?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|Typed|)))) - -;pfTypedId pf == CADR pf -- was ==> - -(DEFUN |pfTypedId| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pfTypedType pf == CADDR pf -- was ==> - -(DEFUN |pfTypedType| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - ;-- Application := (Op: Expr, Arg: Expr) ;pfApplication(pfop, pfarg) == @@ -1017,11 +1004,6 @@ (DEFUN |pfLoopIterators| (|pf|) (PROG () (RETURN (CADR |pf|)))) -;pf0LoopIterators pf == pfParts pfLoopIterators pf - -(DEFUN |pf0LoopIterators| (|pf|) - (PROG () (RETURN (|pfParts| (|pfLoopIterators| |pf|))))) - ;-- Collect := (Body: Expr, Iterators: [Iterator]) ;pfCollect(pfbody, pfiterators) == pfTree('Collect, [pfbody, pfiterators]) @@ -1030,11 +1012,6 @@ (PROG () (RETURN (|pfTree| '|Collect| (LIST |pfbody| |pfiterators|))))) -;pfCollect?(pf) == pfAbSynOp? (pf, 'Collect) - -(DEFUN |pfCollect?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|Collect|)))) - ;pfCollectBody pf == CADR pf -- was ==> (DEFUN |pfCollectBody| (|pf|) (PROG () (RETURN (CADR |pf|)))) @@ -1055,24 +1032,6 @@ (DEFUN |pfForin| (|pflhs| |pfwhole|) (PROG () (RETURN (|pfTree| '|Forin| (LIST |pflhs| |pfwhole|))))) -;pfForin?(pf) == pfAbSynOp? (pf, 'Forin) - -(DEFUN |pfForin?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|Forin|)))) - -;pfForinLhs pf == CADR pf -- was ==> - -(DEFUN |pfForinLhs| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pfForinWhole pf == CADDR pf -- was ==> - -(DEFUN |pfForinWhole| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - -;pf0ForinLhs pf == pfParts pfForinLhs pf - -(DEFUN |pf0ForinLhs| (|pf|) - (PROG () (RETURN (|pfParts| (|pfForinLhs| |pf|))))) - ;-- While := (Cond: Expr) ;pfWhile(pfcond) == pfTree('While, [pfcond]) @@ -1080,15 +1039,6 @@ (DEFUN |pfWhile| (|pfcond|) (PROG () (RETURN (|pfTree| '|While| (LIST |pfcond|))))) -;pfWhile?(pf) == pfAbSynOp? (pf, 'While) - -(DEFUN |pfWhile?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|While|)))) - -;pfWhileCond pf == CADR pf -- was ==> - -(DEFUN |pfWhileCond| (|pf|) (PROG () (RETURN (CADR |pf|)))) - ;-- Until := (Cond: Expr) ;--pfUntil(pfcond) == pfTree('Until, [pfcond]) @@ -1103,15 +1053,6 @@ (DEFUN |pfSuchthat| (|pfcond|) (PROG () (RETURN (|pfTree| '|Suchthat| (LIST |pfcond|))))) -;pfSuchthat?(pf) == pfAbSynOp? (pf, 'Suchthat) - -(DEFUN |pfSuchthat?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|Suchthat|)))) - -;pfSuchthatCond pf == CADR pf -- was ==> - -(DEFUN |pfSuchthatCond| (|pf|) (PROG () (RETURN (CADR |pf|)))) - ;-- Do := (Body: Expr) ;pfDo(pfbody) == pfTree('Do, [pfbody]) @@ -1119,14 +1060,6 @@ (DEFUN |pfDo| (|pfbody|) (PROG () (RETURN (|pfTree| '|Do| (LIST |pfbody|))))) -;pfDo?(pf) == pfAbSynOp? (pf, 'Do) - -(DEFUN |pfDo?| (|pf|) (PROG () (RETURN (|pfAbSynOp?| |pf| '|Do|)))) - -;pfDoBody pf == CADR pf -- was ==> - -(DEFUN |pfDoBody| (|pf|) (PROG () (RETURN (CADR |pf|)))) - ;-- Iterate := (From: ? Id) ;pfIterate(pffrom) == pfTree('Iterate, [pffrom]) @@ -1214,11 +1147,6 @@ (PROG () (RETURN (|pfTree| '|Definition| (LIST |pflhsitems| |pfrhs|))))) -;pfDefinition?(pf) == pfAbSynOp? (pf, 'Definition) - -(DEFUN |pfDefinition?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|Definition|)))) - ;pfDefinitionLhsItems pf == CADR pf -- was ==> (DEFUN |pfDefinitionLhsItems| (|pf|) (PROG () (RETURN (CADR |pf|)))) @@ -1291,24 +1219,6 @@ (DEFUN |pfAssign| (|pflhsitems| |pfrhs|) (PROG () (RETURN (|pfTree| '|Assign| (LIST |pflhsitems| |pfrhs|))))) -;pfAssign?(pf) == pfAbSynOp? (pf, 'Assign) - -(DEFUN |pfAssign?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|Assign|)))) - -;pfAssignLhsItems pf == CADR pf -- was ==> - -(DEFUN |pfAssignLhsItems| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pfAssignRhs pf == CADDR pf -- was ==> - -(DEFUN |pfAssignRhs| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - -;pf0AssignLhsItems pf == pfParts pfAssignLhsItems pf - -(DEFUN |pf0AssignLhsItems| (|pf|) - (PROG () (RETURN (|pfParts| (|pfAssignLhsItems| |pf|))))) - ;-- Typing := (Items: [Typed]) ;pfTyping(pfitems) == pfTree('Typing, [pfitems])