diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 553fce7..abe6aa7 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -5646,6 +5646,231 @@ and the current token (\$ttok) @ +\defun{npConditional}{npConditional} +\calls{npConditional}{npEqKey} +\calls{npConditional}{npLogical} +\calls{npConditional}{npTrap} +\calls{npConditional}{npMissing} +\calls{npConditional}{npElse} +<>= +(defun |npConditional| (f) + (cond + ((and (|npEqKey| 'IF) + (or (|npLogical|) (|npTrap|)) + (or (|npEqKey| 'backset) t)) + (cond + ((|npEqKey| 'settab) + (cond + ((|npEqKey| 'then) + (and (or (apply f nil) (|npTrap|)) + (|npElse| f) + (|npEqKey| 'backtab))) + (t (|npMissing| '|then|)))) + ((|npEqKey| 'then) + (and (or (apply f nil) (|npTrap|)) (|npElse| f))) + (t (|npMissing| '|then|)))) + (t nil))) + + + +@ + +\defun{npElse}{npElse} +\calls{npElse}{npState} +\calls{npElse}{npBacksetElse} +\calls{npElse}{npTrap} +\calls{npElse}{npPush} +\calls{npElse}{pfIf} +\calls{npElse}{npPop3} +\calls{npElse}{npPop2} +\calls{npElse}{npPop1} +\calls{npElse}{npRestore} +\calls{npElse}{pfIfThenOnly} +<>= +(defun |npElse| (f) + (let (a) + (setq a (|npState|)) + (cond + ((|npBacksetElse|) + (and + (or (apply f nil) (|npTrap|)) + (|npPush| (|pfIf| (|npPop3|) (|npPop2|) (|npPop1|))))) + (t + (|npRestore| a) + (|npPush| (|pfIfThenOnly| (|npPop2|) (|npPop1|))))))) + +@ + +\defun{npBacksetElse}{npBacksetElse} +\tpdhere{Well this makes no sense.} +\calls{npBacksetElse}{npEqKey} +<>= +(defun |npBacksetElse| () + (if (|npEqKey| 'backset) + (|npEqKey| 'else) + (|npEqKey| 'else))) + +@ + +\defun{npLogical}{npLogical} +\calls{npLogical}{npLeftAssoc} +\calls{npLogical}{npDisjand} +<>= +(defun |npLogical| () + (|npLeftAssoc| '(or) #'|npDisjand|)) + +@ + +\defun{npDisjand}{npDisjand} +\calls{npDisjand}{npLeftAssoc} +\calls{npDisjand}{npDiscrim} +<>= +(defun |npDisjand| () + (|npLeftAssoc| '(and) #'|npDiscrim|)) + +@ + +\defun{npDiscrim}{npDiscrim} +\calls{npDiscrim}{npLeftAssoc} +\calls{npDiscrim}{npQuiver} +<>= +(defun |npDiscrim| () + (|npLeftAssoc| '(case has) #'|npQuiver|)) + +@ + +\defun{npQuiver}{npQuiver} +\calls{npQuiver}{npRightAssoc} +\calls{npQuiver}{npRelation} +<>= +(defun |npQuiver| () + (|npRightAssoc| '(arrow larrow) #'|npRelation|)) + +@ + +\defun{npRightAssoc}{npRightAssoc} +\calls{npRightAssoc}{npState} +\calls{npRightAssoc}{npInfGeneric} +\calls{npRightAssoc}{npRightAssoc} +\calls{npRightAssoc}{npPush} +\calls{npRightAssoc}{pfApplication} +\calls{npRightAssoc}{npPop2} +\calls{npRightAssoc}{npPop1} +\calls{npRightAssoc}{pfInfApplication} +\calls{npRightAssoc}{npRestore} +<>= +(defun |npRightAssoc| (o p) + (let (a) + (setq a (|npState|)) + (cond + ((apply p nil) + ((lambda () + (loop + (cond + ((not + (and + (|npInfGeneric| o) + (or + (|npRightAssoc| o p) + (progn (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))) nil)))) + (return nil)) + (t + (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))))))) + t) + (t + (|npRestore| a) + nil)))) + +@ + +\defun{npLeftAssoc}{p o p o p o p = (((p o p) o p) o p)} +\begin{verbatim} +p o p o p o p = (((p o p) o p) o p) +p o p o = (p o p) o +;npLeftAssoc(operations,parser)== +; if APPLY(parser,nil) +; then +; while npInfGeneric(operations) +; and (APPLY(parser,nil) or +; (npPush pfApplication(npPop2(),npPop1());false)) +; repeat +; npPush pfInfApplication(npPop2(),npPop2(),npPop1()) +; true +; else false +\end{verbatim} +\calls{npLeftAssoc}{npInfGeneric} +\calls{npLeftAssoc}{npPush} +\calls{npLeftAssoc}{pfApplication} +\calls{npLeftAssoc}{npPop2} +\calls{npLeftAssoc}{npPop1} +\calls{npLeftAssoc}{pfInfApplication} +<>= +(defun |npLeftAssoc| (operations parser) + (when (apply parser nil) + ((lambda nil + (loop + (cond + ((not + (and + (|npInfGeneric| operations) + (or + (apply parser nil) + (progn (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))) nil)))) + (return nil)) + (t + (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))))))) + t)) + +@ + +\defun{npInfGeneric}{npInfGeneric} +\calls{npInfGeneric}{npDDInfKey} +\calls{npInfGeneric}{npEqKey} +<>= +(defun |npInfGeneric| (s) + (and + (|npDDInfKey| s) + (or (|npEqKey| 'backset) t))) + +@ + +\defun{npDDInfKey}{npDDInfKey} +\calls{npDDInfKey}{npInfKey} +\calls{npDDInfKey}{npState} +\calls{npDDInfKey}{npEqKey} +\calls{npDDInfKey}{npInfKey} +\calls{npDDInfKey}{npPush} +\calls{npDDInfKey}{pfSymb} +\calls{npDDInfKey}{npPop1} +\calls{npDDInfKey}{tokPosn} +\calls{npDDInfKey}{npRestore} +\calls{npDDInfKey}{tokConstruct} +\calls{npDDInfKey}{tokPart} +\usesdollar{npDDInfKey}{stok} +<>= +(defun |npDDInfKey| (s) + (let (b a) + (declare (special |$stok|)) + (or + (|npInfKey| s) + (progn + (setq a (|npState|)) + (setq b |$stok|) + (cond + ((and (|npEqKey| '|'|) (|npInfKey| s)) + (|npPush| (|pfSymb| (|npPop1|) (|tokPosn| b)))) + (t + (|npRestore| a) + (cond + ((and (|npEqKey| 'backquote) (|npInfKey| s)) + (setq a (|npPop1|)) + (|npPush| (|tokConstruct| '|idsy| (|tokPart| a) (|tokPosn| a)))) + (t + (|npRestore| a) + nil)))))))) + +@ + \defvar{npPParg} <>= (defvar *npPParg* nil "rewrite npPP without flets, using global scoping") @@ -5833,6 +6058,22 @@ This was rewritten by NAG to remove flet. @ +\defun{pfInfApplication}{pfInfApplication} +\calls{pfInfApplication}{pfListOf} +\calls{pfInfApplication}{pfIdSymbol} +\calls{pfInfApplication}{pfAnd} +\calls{pfInfApplication}{pfOr} +\calls{pfInfApplication}{pfApplication} +\calls{pfInfApplication}{pfTuple} +<>= +(defun |pfInfApplication| (op left right) + (cond + ((eq (|pfIdSymbol| op) '|and|) (|pfAnd| left right)) + ((eq (|pfIdSymbol| op) '|or|) (|pfOr| left right)) + (t (|pfApplication| op (|pfTuple| (|pfListOf| (list left right))))))) + +@ + \defun{pfLeaf}{Construct a Leaf node} \calls{pfLeaf}{tokConstruct} \calls{pfLeaf}{ifcar} @@ -5908,6 +6149,22 @@ This was rewritten by NAG to remove flet. @ +\defun{pfAnd}{Construct an And node} +\calls{pfAnd}{pfTree} +<>= +(defun |pfAnd| (pfleft pfright) + (|pfTree| '|And| (list pfleft pfright))) + +@ + +\defun{pfApplication}{Return an Application node} +\calls{pfApplication}{pfTree} +<>= +(defun |pfApplication| (pfop pfarg) + (|pfTree| '|Application| (list pfop pfarg))) + +@ + \defun{pfApplicationArg}{Return the Arg part of an Application node} <>= (defun |pfApplicationArg| (pf) @@ -6418,6 +6675,14 @@ This was rewritten by NAG to remove flet. @ +\defun{pfOr}{Construct an Or node} +\calls{pfOr}{pfTree} +<>= +(defun |pfOr| (pfleft pfright) + (|pfTree| '|Or| (list pfleft pfright))) + +@ + \defun{pfOr?}{Is this an Or node?} \calls{pfOr?}{pfAbSynOp?} <>= @@ -6990,22 +7255,22 @@ output is an old-parser-style s-expression. \calls{pfLiteral2Sex}{keyedSystemError} \usesdollar{pfLiteral2Sex}{insideRule} <>= -(defun |pfLiteral2Sex| (|pf|) - (let (|s| |type|) +(defun |pfLiteral2Sex| (pf) + (let (s type) (declare (special |$insideRule|)) - (setq |type| (|pfLiteralClass| |pf|)) + (setq type (|pfLiteralClass| pf)) (cond - ((eq |type| '|integer|) (read-from-string (|pfLiteralString| |pf|))) - ((or (eq |type| '|string|) (eq |type| '|char|)) - (|pfLiteralString| |pf|)) - ((eq |type| '|float|) (|float2Sex| (|pfLiteralString| |pf|))) - ((eq |type| '|symbol|) + ((eq type '|integer|) (read-from-string (|pfLiteralString| pf))) + ((or (eq type '|string|) (eq type '|char|)) + (|pfLiteralString| pf)) + ((eq type '|float|) (|float2Sex| (|pfLiteralString| pf))) + ((eq type '|symbol|) (if |$insideRule| (progn - (setq |s| (|pfSymbolSymbol| |pf|)) - (list 'quote |s|)) - (|pfSymbolSymbol| |pf|))) - ((eq |type| '|expression|) (list 'quote (|pfLeafToken| |pf|))) + (setq s (|pfSymbolSymbol| pf)) + (list 'quote s)) + (|pfSymbolSymbol| pf))) + ((eq type '|expression|) (list 'quote (|pfLeafToken| pf))) (t (|keyedSystemError| 'S2GE0017 (list "pfLiteral2Sex: unexpected form")))))) @@ -18990,9 +19255,9 @@ explanations see the list structure section \ref{Theliststructure}. (cond ((pairp opt) (setq opt - (do ((t2 opt (cdr t2)) t1 (|o| nil)) - ((or (atom t2) (progn (setq |o| (car t2)) nil)) t1) - (setq t1 (append t1 (cons |o| (cons " " nil)))))))) + (do ((t2 opt (cdr t2)) t1 (o nil)) + ((or (atom t2) (progn (setq o (car t2)) nil)) t1) + (setq t1 (append t1 (cons o (cons " " nil)))))))) (|sayBrightly| (|concat| setoption '|%b| opt '|%d|))) (string (setq opt (|object2String| (|eval| (fifth setdata)))) @@ -35460,23 +35725,32 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> <> <> <> +<> +<> <> +<> +<> +<> <> <> <> <> <> +<> <> <> <> +<> <> <> +<> <> <> <> @@ -35492,7 +35766,9 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> +<> <> <> <> @@ -35527,10 +35803,12 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> <> +<> <> <> <> @@ -35574,6 +35852,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -35608,6 +35887,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> diff --git a/changelog b/changelog index 28954e8..287182d 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20100214 tpd src/axiom-website/patches.html 20100214.02.tpd.patch +20100214 tpd src/interp/ptrees.lisp treeshake +20100214 tpd src/interp/cparse.lisp treeshake +20100214 tpd books/bookvol5 treeshake cparse, ptrees 20100214 tpd src/axiom-website/patches.html 20100214.01.tpd.patch 20100214 tpd src/interp/vmlisp.lisp treeshake 20100214 tpd src/interp/serror.lisp treeshake diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 5a3dee3..942c96c 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2455,5 +2455,7 @@ books/bookvol10.1 add quaternion quote from Altmann
books/bookvol5 treeshake ptrees.lisp
20100214.01.tpd.patch books/bookvol5 treeshake cparse, ptrees, serror, vmlisp
+20100214.02.tpd.patch +books/bookvol5 treeshake cparse, ptrees
diff --git a/src/interp/cparse.lisp.pamphlet b/src/interp/cparse.lisp.pamphlet index 3addd2c..2be2ccc 100644 --- a/src/interp/cparse.lisp.pamphlet +++ b/src/interp/cparse.lisp.pamphlet @@ -252,72 +252,6 @@ (OR (APPLY |p| NIL) (|npTrap|)) (|npPush| (FUNCALL |f| (|npPop1|))))))) -;npRightAssoc(o,p)== -; a:=npState() -; if APPLY(p,nil) -; then -; while npInfGeneric o and (npRightAssoc(o,p) -; or (npPush pfApplication(npPop2(),npPop1());false)) repeat -; npPush pfInfApplication(npPop2(),npPop2(),npPop1()) -; true -; else -; npRestore a -; false -(DEFUN |npRightAssoc| (|o| |p|) - (PROG (|a|) - (RETURN - (PROGN - (SETQ |a| (|npState|)) - (COND - ((APPLY |p| NIL) - ((LAMBDA () - (LOOP - (COND - ((NOT - (AND - (|npInfGeneric| |o|) - (OR - (|npRightAssoc| |o| |p|) - (PROGN (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))) NIL)))) - (RETURN NIL)) - ((QUOTE T) - (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))))))) - T) - ((QUOTE T) (|npRestore| |a|) NIL)))))) - -;-- p o p o p o p = (((p o p) o p) o p) -;-- p o p o = (p o p) o -; -;npLeftAssoc(operations,parser)== -; if APPLY(parser,nil) -; then -; while npInfGeneric(operations) -; and (APPLY(parser,nil) or -; (npPush pfApplication(npPop2(),npPop1());false)) -; repeat -; npPush pfInfApplication(npPop2(),npPop2(),npPop1()) -; true -; else false -(DEFUN |npLeftAssoc| (|operations| |parser|) - (PROG NIL - (RETURN - (COND - ((APPLY |parser| NIL) - ((LAMBDA NIL - (LOOP - (COND - ((NOT - (AND - (|npInfGeneric| |operations|) - (OR - (APPLY |parser| NIL) - (PROGN (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))) NIL)))) - (RETURN NIL)) - ((QUOTE T) - (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))))))) - T) - ((QUOTE T) NIL))))) - ;npInfixOp()== ; EQ(CAAR $stok,"key") and ; GET($ttok,"INFGENERIC") and npPushId() @@ -371,117 +305,6 @@ (RETURN (AND (EQ (CAAR |$stok|) (QUOTE |key|)) (MEMQ |$ttok| |s|) (|npPushId|))))) -;npDDInfKey s== -; npInfKey s or -; a:=npState() -; b:=$stok -; npEqKey "'" and npInfKey s => -; npPush pfSymb (npPop1 () ,tokPosn b) -; npRestore a -; npEqKey "BACKQUOTE" and npInfKey s => -; a:=npPop1() -; npPush tokConstruct("idsy",tokPart a,tokPosn a) -; npRestore a -; false -(DEFUN |npDDInfKey| (|s|) - (PROG (|b| |a|) - (DECLARE (SPECIAL |$stok|)) - (RETURN - (OR - (|npInfKey| |s|) - (PROGN - (SETQ |a| (|npState|)) - (SETQ |b| |$stok|) - (COND - ((AND (|npEqKey| (QUOTE |'|)) (|npInfKey| |s|)) - (|npPush| (|pfSymb| (|npPop1|) (|tokPosn| |b|)))) - (#0=(QUOTE T) - (PROGN - (|npRestore| |a|) - (COND - ((AND (|npEqKey| (QUOTE BACKQUOTE)) (|npInfKey| |s|)) - (PROGN - (SETQ |a| (|npPop1|)) - (|npPush| - (|tokConstruct| (QUOTE |idsy|) (|tokPart| |a|) (|tokPosn| |a|))))) - (#0# (PROGN (|npRestore| |a|) NIL))))))))))) - -;npInfGeneric s== npDDInfKey s and -; (npEqKey "BACKSET" or true) -(DEFUN |npInfGeneric| (|s|) - (PROG NIL - (RETURN - (AND - (|npDDInfKey| |s|) - (OR (|npEqKey| (QUOTE BACKSET)) T))))) - -;npConditional f== -; if npEqKey "IF" and (npLogical() or npTrap()) and -; (npEqKey "BACKSET" or true) -; then -; if npEqKey "SETTAB" -; then if npEqKey "THEN" -; then (APPLY(f,nil) or npTrap()) and npElse(f) -; and npEqKey "BACKTAB" -; else npMissing "then" -; else if npEqKey "THEN" -; then (APPLY(f,nil) or npTrap()) and npElse(f) -; else npMissing "then" -; else false -(DEFUN |npConditional| (|f|) - (PROG NIL - (RETURN - (COND - ((AND - (|npEqKey| (QUOTE IF)) - (OR (|npLogical|) (|npTrap|)) - (OR (|npEqKey| (QUOTE BACKSET)) T)) - (COND - ((|npEqKey| (QUOTE SETTAB)) - (COND - ((|npEqKey| (QUOTE THEN)) - (AND - (OR (APPLY |f| NIL) (|npTrap|)) - (|npElse| |f|) - (|npEqKey| (QUOTE BACKTAB)))) - (#0=(QUOTE T) (|npMissing| (QUOTE |then|))))) - ((|npEqKey| (QUOTE THEN)) - (AND (OR (APPLY |f| NIL) (|npTrap|)) (|npElse| |f|))) - (#0# (|npMissing| (QUOTE |then|))))) - (#0# NIL))))) - -;npElse(f)== -; a:=npState() -; if npBacksetElse() -; then (APPLY(f,nil) or npTrap()) and -; npPush pfIf(npPop3(),npPop2(),npPop1()) -; else -; npRestore a -; npPush pfIfThenOnly(npPop2(),npPop1()) -(DEFUN |npElse| (|f|) - (PROG (|a|) - (RETURN - (PROGN - (SETQ |a| (|npState|)) - (COND - ((|npBacksetElse|) - (AND - (OR (APPLY |f| NIL) (|npTrap|)) - (|npPush| (|pfIf| (|npPop3|) (|npPop2|) (|npPop1|))))) - ((QUOTE T) - (|npRestore| |a|) (|npPush| (|pfIfThenOnly| (|npPop2|) (|npPop1|))))))))) - -;npBacksetElse()== -; if npEqKey "BACKSET" -; then npEqKey "ELSE" -; else npEqKey "ELSE" -(DEFUN |npBacksetElse| () - (PROG NIL - (RETURN - (COND - ((|npEqKey| (QUOTE BACKSET)) (|npEqKey| (QUOTE ELSE))) - ((QUOTE T) (|npEqKey| (QUOTE ELSE))))))) - ;-- Parsing functions ;$npTokToNames:= ["~","#","[]","{}", "[||]","{||}"] @@ -972,30 +795,6 @@ (QUOTE (EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE)) (FUNCTION |npSynthetic|))))) -;npQuiver() == npRightAssoc('(ARROW LARROW),function npRelation) -(DEFUN |npQuiver| () - (PROG NIL - (RETURN - (|npRightAssoc| (QUOTE (ARROW LARROW)) (FUNCTION |npRelation|))))) - -;npDiscrim() == npLeftAssoc ('(CASE HAS), function npQuiver) -(DEFUN |npDiscrim| () - (PROG NIL - (RETURN - (|npLeftAssoc| (QUOTE (CASE HAS)) (FUNCTION |npQuiver|))))) - -;npDisjand() == npLeftAssoc('(AND ),function npDiscrim) -(DEFUN |npDisjand| () - (PROG NIL - (RETURN - (|npLeftAssoc| (QUOTE (AND)) (FUNCTION |npDiscrim|))))) - -;npLogical() == npLeftAssoc('(OR ),function npDisjand) -(DEFUN |npLogical| () - (PROG NIL - (RETURN - (|npLeftAssoc| (QUOTE (OR)) (FUNCTION |npDisjand|))))) - ;npSuch() == npLeftAssoc( '(BAR),function npLogical) (DEFUN |npSuch| () (PROG NIL diff --git a/src/interp/ptrees.lisp.pamphlet b/src/interp/ptrees.lisp.pamphlet index 4cf2317..5b81678 100644 --- a/src/interp/ptrees.lisp.pamphlet +++ b/src/interp/ptrees.lisp.pamphlet @@ -101,35 +101,6 @@ (|pfTree| '|WIf| (LIST (|pfIfCond| |form|) (|pfIfThen| |form|) |b|)))))) -;pfInfApplication(op,left,right)== -; pfCheckInfop left => -; pfWrong(pfDocument ['"infop as argument to infop"],pfListOf []) -; pfCheckInfop right => -; pfWrong(pfDocument ['"infop as argument to infop"],pfListOf []) -; EQ(pfIdSymbol op,"and")=> pfAnd (left,right) -; EQ(pfIdSymbol op, "or")=> pfOr (left,right) -; pfApplication(op,pfTuple pfListOf [left,right]) - -(DEFUN |pfInfApplication| (|op| |left| |right|) - (PROG () - (RETURN - (COND - ((|pfCheckInfop| |left|) - (|pfWrong| (|pfDocument| (LIST "infop as argument to infop")) - (|pfListOf| NIL))) - ((|pfCheckInfop| |right|) - (|pfWrong| (|pfDocument| (LIST "infop as argument to infop")) - (|pfListOf| NIL))) - ((EQ (|pfIdSymbol| |op|) '|and|) (|pfAnd| |left| |right|)) - ((EQ (|pfIdSymbol| |op|) '|or|) (|pfOr| |left| |right|)) - ('T - (|pfApplication| |op| - (|pfTuple| (|pfListOf| (LIST |left| |right|))))))))) - -;pfCheckInfop form== false - -(DEFUN |pfCheckInfop| (|form|) (PROG () (RETURN NIL))) - ;pfFromDom(dom,expr)== ; if pfApplication? expr ; then pfApplication(pfFromdom(pfApplicationOp expr,dom), @@ -322,12 +293,6 @@ ;pfApplication(pfop, pfarg) == ; pfTree('Application, [pfop, pfarg]) -(DEFUN |pfApplication| (|pfop| |pfarg|) - (PROG () (RETURN (|pfTree| '|Application| (LIST |pfop| |pfarg|))))) - -;-- Tuple := (Parts: [Expr]) -; - ;-- Tagged := (Tag: Expr, Expr: Expr) ;pfTagged(pftag, pfexpr) == pfTree('Tagged, [pftag, pfexpr])