diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 032bc76..b226c88 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -5694,6 +5694,45 @@ and the current token (\$ttok) @ +\defun{npDefn}{npDefn} +\calls{npDefn}{npEqKey} +\calls{npDefn}{npPP} +\calls{npDefn}{npDef} +<>= +(defun |npDefn| () + (and + (|npEqKey| 'defn) + (|npPP| #'|npDef|))) + +@ + +\defun{npDef}{npDef} +\calls{npDef}{npMatch} +\calls{npDef}{pfCheckItOut} +\calls{npDef}{npPop1} +\calls{npDef}{npDefTail} +\calls{npDef}{npTrap} +\calls{npDef}{npPop1} +\calls{npDef}{npPush} +\calls{npDef}{pfDefinition} +\calls{npDef}{pfPushBody} +<>= +(defun |npDef| () + (let (body rt arg op tmp1) + (when (|npMatch|) + ; [op,arg,rt]:= pfCheckItOut(npPop1()) + (setq tmp1 (|pfCheckItOut| (|npPop1|))) + (setq op (car tmp1)) + (setq arg (cadr tmp1)) + (setq rt (caddr tmp1)) + (or (|npDefTail|) (|npTrap|)) + (setq body (|npPop1|)) + (if (null arg) + (|npPush| (|pfDefinition| op body)) + (|npPush| (|pfDefinition| op (|pfPushBody| rt arg body))))))) + +@ + \defun{npBPileDefinition}{npBPileDefinition} \calls{npBPileDefinition}{npPileBracketed} \calls{npBPileDefinition}{npPileDefinitionlist} @@ -5709,6 +5748,27 @@ and the current token (\$ttok) @ +\defun{npPileBracketed}{npPileBracketed} +\calls{npPileBracketed}{npEqKey} +\calls{npPileBracketed}{npPush} +\calls{npPileBracketed}{pfNothing} +\calls{npPileBracketed}{npMissing} +\calls{npPileBracketed}{pfPile} +\calls{npPileBracketed}{npPop1} +<>= +(defun |npPileBracketed| (|f|) + (cond + ((|npEqKey| 'settab) + (cond + ((|npEqKey| 'backtab) (|npPush| (|pfNothing|))) ; never happens + ((and (apply |f| nil) + (or (|npEqKey| 'backtab) (|npMissing| '|backtab|))) + (|npPush| (|pfPile| (|npPop1|)))) + (t nil))) + (t nil))) + +@ + \defun{npPileDefinitionlist}{npPileDefinitionlist} \calls{npPileDefinitionlist}{npListAndRecover} \calls{npPileDefinitionlist}{npDefinitionlist} @@ -6058,6 +6118,64 @@ and the current token (\$ttok) @ +\defun{npRelation}{npRelation} +\calls{npRelation}{npLeftAssoc} +\calls{npRelation}{npSynthetic} +<>= +(defun |npRelation| () + (|npLeftAssoc| '(equal notequal lt le gt ge oangle cangle) #'|npSynthetic|)) + +@ + +\defun{npSynthetic}{npSynthetic} +\calls{npSynthetic}{npBy} +\calls{npSynthetic}{npAmpersandFrom} +\calls{npSynthetic}{npPush} +\calls{npSynthetic}{pfApplication} +\calls{npSynthetic}{npPop2} +\calls{npSynthetic}{npPop1} +\calls{npSynthetic}{pfInfApplication} +<>= +(defun |npSynthetic| () + (cond + ((|npBy|) + ((lambda () + (loop + (cond + ((not (and (|npAmpersandFrom|) + (or (|npBy|) + (progn + (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))) + nil)))) + (return nil)) + (t + (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))))))) + t) + (t nil))) + +@ + +\defun{npAmpersandFrom}{npAmpersandFrom} +\calls{npAmpersandFrom}{npAmpersand} +\calls{npAmpersandFrom}{npFromdom} +<>= +(defun |npAmpersandFrom| () + (and (|npAmpersand|) (|npFromdom|))) + +@ + +\defun{npAmpersand}{npAmpersand} +\calls{npAmpersand}{npEqKey} +\calls{npAmpersand}{npName} +\calls{npAmpersand}{npTrap} +<>= +(defun |npAmpersand| () + (and + (|npEqKey| 'ampersand) + (or (|npName|) (|npTrap|)))) + +@ + \defun{npRightAssoc}{npRightAssoc} \calls{npRightAssoc}{npState} \calls{npRightAssoc}{npInfGeneric} @@ -6468,6 +6586,99 @@ of the form ('expression expr position) @ +\defun{pfCheckItOut}{Deconstruct nodes to lists} +\calls{pfCheckItOut}{pfTagged?} +\calls{pfCheckItOut}{pfTaggedExpr} +\calls{pfCheckItOut}{pfNothing} +\calls{pfCheckItOut}{pfTaggedTag} +\calls{pfCheckItOut}{pfId?} +\calls{pfCheckItOut}{pfListOf} +\calls{pfCheckItOut}{pfTyped} +\calls{pfCheckItOut}{pfCollect1?} +\calls{pfCheckItOut}{pfCollectVariable1} +\calls{pfCheckItOut}{pfTuple?} +\calls{pfCheckItOut}{pf0TupleParts} +\calls{pfCheckItOut}{pfTaggedToTyped} +\calls{pfCheckItOut}{pfDefinition?} +\calls{pfCheckItOut}{pfApplication?} +\calls{pfCheckItOut}{pfFlattenApp} +\calls{pfCheckItOut}{pfTaggedToTyped1} +\calls{pfCheckItOut}{pfTransformArg} +\calls{pfCheckItOut}{npTrapForm} +<>= +(defun |pfCheckItOut| (x) + (let (args op ls form rt result) + (if (|pfTagged?| x) + (setq rt (|pfTaggedExpr| x)) + (setq rt (|pfNothing|))) + (if (|pfTagged?| x) + (setq form (|pfTaggedTag| x)) + (setq form x)) + (cond + ((|pfId?| form) + (list (|pfListOf| (list (|pfTyped| form rt))) nil rt)) + ((|pfCollect1?| form) + (list (|pfListOf| (list (|pfCollectVariable1| form))) nil rt)) + ((|pfTuple?| form) + (list (|pfListOf| + (dolist (part (|pf0TupleParts| form) (nreverse result)) + (push (|pfTaggedToTyped| part) result))) + nil rt)) + ((|pfDefinition?| form) + (list (|pfListOf| (list (|pfTyped| form (|pfNothing|)))) nil rt)) + ((|pfApplication?| form) + (setq ls (|pfFlattenApp| form)) + (setq op (|pfTaggedToTyped1| (car ls))) + (setq args + (dolist (part (cdr ls) (nreverse result)) + (push (|pfTransformArg| part) result))) + (list (|pfListOf| (list op)) args rt)) + (t (|npTrapForm| form))))) + +@ + +\defun{pfTransformArg}{pfTransformArg} +\calls{pfTransformArg}{pfTuple?} +\calls{pfTransformArg}{pf0TupleParts} +\calls{pfTransformArg}{pfListOf} +\calls{pfTransformArg}{pfTaggedToTyped1} +<>= +(defun |pfTransformArg| (args) + (let (arglist result) + (if (|pfTuple?| args) + (setq arglist (|pf0TupleParts| args)) + (setq arglist (list args))) + (|pfListOf| + (dolist (|i| arglist (nreverse result)) + (push (|pfTaggedToTyped1| |i|) result))))) + +@ + +\defun{pfTaggedToTyped1}{pfTaggedToTyped1} +\calls{pfTaggedToTyped1}{pfCollect1?} +\calls{pfTaggedToTyped1}{pfCollectVariable1} +\calls{pfTaggedToTyped1}{pfDefinition?} +\calls{pfTaggedToTyped1}{pfTyped} +\calls{pfTaggedToTyped1}{pfNothing} +\calls{pfTaggedToTyped1}{pfTaggedToTyped} +<>= +(defun |pfTaggedToTyped1| (arg) + (cond + ((|pfCollect1?| arg) (|pfCollectVariable1| arg)) + ((|pfDefinition?| arg) (|pfTyped| arg (|pfNothing|))) + (t (|pfTaggedToTyped| arg)))) + +@ + +\defun{pfSuch}{pfSuch} +\calls{pfSuch}{pfInfApplication} +\calls{pfSuch}{pfId} +<>= +(defun |pfSuch| (x y) + (|pfInfApplication| (|pfId| '|\||) x y)) + +@ + \section{Special Nodes} \defun{pfListOf}{Create a Listof node} @@ -6504,6 +6715,14 @@ of the form ('expression expr position) @ +\defun{pfId}{Construct an Id node} +\calls{pfId}{pfLeaf} +<>= +(defun |pfId| (expr) + (|pfLeaf| '|id| expr)) + +@ + \defun{pfId?}{Is this an Id node?} \calls{pfId?}{pfAbSynOp?} <>= @@ -6520,22 +6739,6 @@ of the form ('expression expr position) @ -\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} @@ -6597,6 +6800,28 @@ of the form ('expression expr position) @ +\defun{pfPile}{Return the argument unchanged} +<>= +(defun |pfPile| (part) + part) + +@ + +\defun{pfPushBody}{pfPushBody} +\calls{pfPushBody}{pfLambda} +\calls{pfPushBody}{pfNothing} +\calls{pfPushBody}{pfPushBody} +<>= +(defun |pfPushBody| (rt args body) + (cond + ((null args) body) + ((null (cdr args)) (|pfLambda| (car args) rt body)) + (t + (|pfLambda| (car args) (|pfNothing|) + (|pfPushBody| rt (cdr args) body))))) + +@ + \defun{pfSexpr}{An S-expression which people can read.} \calls{pfSexpr}{pfSexpr,strip} <>= @@ -6846,6 +7071,14 @@ of the form ('expression expr position) @ +\defun{pfDefinition}{pfDefinition} +\calls{pfDefinition}{pfTree} +<>= +(defun |pfDefinition| (pflhsitems pfrhs) + (|pfTree| '|Definition| (list pflhsitems pfrhs))) + +@ + \defun{pfDefinitionLhsItems}{Return the Lhs of a Definition node} <>= (defun |pfDefinitionLhsItems| (pf) @@ -7065,6 +7298,22 @@ of the form ('expression expr position) @ +\defun{pfInfApplication}{Handle an infix application} +\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{pfLam}{pfLam} \calls{pfLam}{pfAbSynOp?} \calls{pfLam}{pfFirst} @@ -7435,6 +7684,33 @@ of the form ('expression expr position) @ +\defun{pfTaggedToTyped}{pfTaggedToTyped} +\calls{pfTaggedToTyped}{pfTagged?} +\calls{pfTaggedToTyped}{pfTaggedExpr} +\calls{pfTaggedToTyped}{pfNothing} +\calls{pfTaggedToTyped}{pfTaggedTag} +\calls{pfTaggedToTyped}{pfId?} +\calls{pfTaggedToTyped}{pfId} +\calls{pfTaggedToTyped}{pfTyped} +\calls{pfTaggedToTyped}{pfSuch} +\calls{pfTaggedToTyped}{pfInfApplication} +<>= +(defun |pfTaggedToTyped| (arg) + (let (a form rt) + (if (|pfTagged?| arg) + (setq rt (|pfTaggedExpr| arg)) + (setq rt (|pfNothing|))) + (if (|pfTagged?| arg) + (setq form (|pfTaggedTag| arg)) + (setq form arg)) + (cond + ((null (|pfId?| form)) + (setq a (|pfId| (gensym))) + (|pfTyped| (|pfSuch| a (|pfInfApplication| (|pfId| '=) a form)) rt)) + (t (|pfTyped| form rt))))) + +@ + \defun{pfTweakIf}{pfTweakIf} \calls{pfTweakIf}{pfIfElse} \calls{pfTweakIf}{pfNothing?} @@ -8380,7 +8656,7 @@ output is an old-parser-style s-expression. (setq argTypeList (cons retType (nreverse argTypeList))) (cons argList (list argTypeList - (mapcar #'(lambda (x) nil) argTypeList) + (mapcar #'(lambda (x) (declare (ignore x)) nil) argTypeList) (|pf2Sex1| (|pfLambdaBody| pf))))) (t (cons '|id| (list '(nil) '(nil) (|pf2Sex1| pf))))))) @@ -13404,18 +13680,18 @@ in practice. \usesdollar{printSynonyms}{CommandSynonymAlist} \usesdollar{printSynonyms}{linelength} <>= -(defun |printSynonyms| (|patterns|) - (prog (|ls| t1) +(defun |printSynonyms| (patterns) + (prog (ls t1) (declare (special |$CommandSynonymAlist| $linelength)) (|centerAndHighlight| '|System Command Synonyms| $linelength (|specialChar| '|hbar|)) - (setq |ls| - (|filterListOfStringsWithFn| |patterns| + (setq ls + (|filterListOfStringsWithFn| patterns (do ((t2 (|synonymsForUserLevel| |$CommandSynonymAlist|) (cdr t2))) ((atom t2) (nreverse0 t1)) (push (cons (stringimage (caar t2)) (cdar t2)) t1)) (|function| car))) - (|printLabelledList| |ls| "user" "synonyms" ")" |patterns|))) + (|printLabelledList| ls "user" "synonyms" ")" patterns))) @ @@ -36299,6 +36575,8 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> +<> <> <> <> @@ -36311,9 +36589,11 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> +<> <> <> <> @@ -36338,6 +36618,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -36350,6 +36631,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -36362,6 +36644,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -36410,6 +36693,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -36418,6 +36702,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -36439,6 +36724,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -36488,9 +36774,11 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> +<> <> <> <> @@ -36511,6 +36799,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -36520,6 +36809,9 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> +<> +<> <> <> <> diff --git a/changelog b/changelog index ea19692..0240200 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20100217 tpd src/axiom-website/patches.html 20100217.01.tpd.patch +20100217 tpd src/interp/ptrees.lisp treeshake +20100217 tpd src/interp/cparse.lisp treeshake +20100217 tpd books/bookvol5 treeshake cparse, ptrees 20100216 tpd src/axiom-website/patches.html 20100216.03.tpd.patch 20100216 tpd src/interp/serror.lisp treeshake 20100216 tpd src/interp/posit.lisp treeshake diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 7488d66..6b3659e 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2465,5 +2465,7 @@ books/bookvol5 add )set break quit
books/bookvol10.1 add Clifford chapter, per John Fletcher
20100216.03.tpd.patch books/bookvol5 treeshake cparse posit serror
+20100217.01.tpd.patch +books/bookvol5 treeshake cparse, ptrees
diff --git a/src/interp/cparse.lisp.pamphlet b/src/interp/cparse.lisp.pamphlet index 4d2d60a..9f2207e 100644 --- a/src/interp/cparse.lisp.pamphlet +++ b/src/interp/cparse.lisp.pamphlet @@ -133,28 +133,6 @@ (|npBraced| |f|) (|npAngleBared| |f|))))) -;npPileBracketed f== -; if npEqKey "SETTAB" -; then if npEqKey "BACKTAB" -; then npPush pfNothing() -- never happens -; else if APPLY(f,nil) and (npEqKey "BACKTAB" or npMissing "backtab") -; then npPush pfPile npPop1() -; else false -; else false -(DEFUN |npPileBracketed| (|f|) - (PROG NIL - (RETURN - (COND - ((|npEqKey| (QUOTE SETTAB)) - (COND - ((|npEqKey| (QUOTE BACKTAB)) (|npPush| (|pfNothing|))) - ((AND - (APPLY |f| NIL) - (OR (|npEqKey| (QUOTE BACKTAB)) (|npMissing| (QUOTE |backtab|)))) - (|npPush| (|pfPile| (|npPop1|)))) - (#0=(QUOTE T) NIL))) - (#0# NIL))))) - ;npListofFun(f,h,g)== ; if APPLY(f,nil) ; then @@ -674,59 +652,6 @@ (RETURN (|npLeftAssoc| (QUOTE (BY)) (FUNCTION |npInterval|))))) -;npAmpersand()== npEqKey "AMPERSAND" and (npName() or npTrap()) -(DEFUN |npAmpersand| () - (PROG NIL - (RETURN - (AND - (|npEqKey| (QUOTE AMPERSAND)) - (OR (|npName|) (|npTrap|)))))) - -;npAmpersandFrom()== npAmpersand() and npFromdom() -(DEFUN |npAmpersandFrom| () - (PROG NIL - (RETURN - (AND (|npAmpersand|) (|npFromdom|))))) - -;npSynthetic()== -; if npBy() -; then -; while npAmpersandFrom() and (npBy() or -; (npPush pfApplication(npPop2(),npPop1());false)) repeat -; npPush pfInfApplication(npPop2(),npPop2(),npPop1()) -; true -; else false -(DEFUN |npSynthetic| () - (PROG NIL - (RETURN - (COND - ((|npBy|) - ((LAMBDA () - (LOOP - (COND - ((NOT - (AND - (|npAmpersandFrom|) - (OR - (|npBy|) - (PROGN (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))) NIL)))) - (RETURN NIL)) - ((QUOTE T) - (|npPush| - (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))))))) - T) - ((QUOTE T) NIL))))) - -;npRelation()== -; npLeftAssoc ('(EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE), -; function npSynthetic) -(DEFUN |npRelation| () - (PROG NIL - (RETURN - (|npLeftAssoc| - (QUOTE (EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE)) - (FUNCTION |npSynthetic|))))) - ;npSuch() == npLeftAssoc( '(BAR),function npLogical) (DEFUN |npSuch| () (PROG NIL @@ -1170,14 +1095,6 @@ (RETURN (|npLetQualified| (FUNCTION |npDefinitionOrStatement|))))) -;npDefn()== npEqKey "DEFN" and npPP function npDef -(DEFUN |npDefn| () - (PROG NIL - (RETURN - (AND - (|npEqKey| (QUOTE DEFN)) - (|npPP| (FUNCTION |npDef|)))))) - ;npFix()== npEqKey "FIX" and npPP function npDef ; and npPush pfFix npPop1 () (DEFUN |npFix| () @@ -1456,24 +1373,6 @@ ; null arg => npPush pfDefinition (op,body) ; npPush pfDefinition (op,pfPushBody(rt,arg,body)) ; false -(DEFUN |npDef| () - (PROG (|body| |rt| |arg| |op| |LETTMP#1|) - (RETURN - (COND - ((|npMatch|) - (PROGN - (SETQ |LETTMP#1| (|pfCheckItOut| (|npPop1|))) - (SETQ |op| (CAR |LETTMP#1|)) - (SETQ |arg| (CADR . #0=(|LETTMP#1|))) - (SETQ |rt| (CADDR . #0#)) - (OR (|npDefTail|) (|npTrap|)) - (SETQ |body| (|npPop1|)) - (COND - ((NULL |arg|) - (|npPush| (|pfDefinition| |op| |body|))) - (#1=(QUOTE T) - (|npPush| (|pfDefinition| |op| (|pfPushBody| |rt| |arg| |body|))))))) - (#1# NIL))))) ;npMdef()== ; npQuiver() => diff --git a/src/interp/ptrees.lisp.pamphlet b/src/interp/ptrees.lisp.pamphlet index 1258def..e5ec6ff 100644 --- a/src/interp/ptrees.lisp.pamphlet +++ b/src/interp/ptrees.lisp.pamphlet @@ -18,9 +18,6 @@ (PROG () (RETURN (|tokPosn| |form|)))) ;--% LEAVES -;pfId(expr) == pfLeaf('id, expr) - -(DEFUN |pfId| (|expr|) (PROG () (RETURN (|pfLeaf| '|id| |expr|)))) ;pfIdPos(expr,pos) == pfLeaf('id,expr,pos) @@ -132,10 +129,6 @@ (DEFUN |pfParen| (|a| |part|) (PROG () (RETURN |part|))) -;pfPile(part)==part - -(DEFUN |pfPile| (|part|) (PROG () (RETURN |part|))) - ;pfSpread(l,t)== [pfTyped(i,t) for i in l] (DEFUN |pfSpread| (|l| |t|) @@ -412,14 +405,6 @@ (DEFUN |pfMacroRhs| (|pf|) (PROG () (RETURN (CADDR |pf|)))) -;-- Definition := (LhsItems: [Typed], Rhs: Expr) - -;pfDefinition(pflhsitems, pfrhs) == pfTree('Definition, [pflhsitems, pfrhs]) - -(DEFUN |pfDefinition| (|pflhsitems| |pfrhs|) - (PROG () - (RETURN (|pfTree| '|Definition| (LIST |pflhsitems| |pfrhs|))))) - ;-- Assign := (LhsItems: [AssLhs], Rhs: Expr) ; ;pfAssign(pflhsitems, pfrhs) == pfTree('Assign, [pflhsitems, pfrhs]) @@ -476,53 +461,6 @@ (DEFUN |pfQualType| (|pftype| |pfqual|) (PROG () (RETURN (|pfTree| '|QualType| (LIST |pftype| |pfqual|))))) -;pfSuch(x,y)== pfInfApplication(pfId "|",x,y) - -(DEFUN |pfSuch| (|x| |y|) - (PROG () (RETURN (|pfInfApplication| (|pfId| '|\||) |x| |y|)))) - -;pfTaggedToTyped x== -; rt:=if pfTagged? x then pfTaggedExpr x else pfNothing() -; form:= if pfTagged? x then pfTaggedTag x else x -; not pfId? form => -; a:=pfId GENSYM() -; pfTyped(pfSuch(a, -; pfInfApplication (pfId "=", a,form)),rt) -; pfTyped(form,rt) - -(DEFUN |pfTaggedToTyped| (|x|) - (PROG (|a| |form| |rt|) - (RETURN - (PROGN - (SETQ |rt| - (COND - ((|pfTagged?| |x|) (|pfTaggedExpr| |x|)) - ('T (|pfNothing|)))) - (SETQ |form| - (COND ((|pfTagged?| |x|) (|pfTaggedTag| |x|)) ('T |x|))) - (COND - ((NULL (|pfId?| |form|)) - (PROGN - (SETQ |a| (|pfId| (GENSYM))) - (|pfTyped| - (|pfSuch| |a| - (|pfInfApplication| (|pfId| '=) |a| |form|)) - |rt|))) - ('T (|pfTyped| |form| |rt|))))))) - -;pfTaggedToTyped1 x== -; pfCollect1? x => pfCollectVariable1 x -; pfDefinition? x => pfTyped(x,pfNothing()) -; pfTaggedToTyped x - -(DEFUN |pfTaggedToTyped1| (|x|) - (PROG () - (RETURN - (COND - ((|pfCollect1?| |x|) (|pfCollectVariable1| |x|)) - ((|pfDefinition?| |x|) (|pfTyped| |x| (|pfNothing|))) - ('T (|pfTaggedToTyped| |x|)))))) - ;pfCollectVariable1 x== ; a := pfApplicationArg x ; var:=first pf0TupleParts a @@ -541,98 +479,6 @@ (|pfSuch| (|pfTypedId| |id|) (CADR (|pf0TupleParts| |a|))) (|pfTypedType| |id|)))))) -;pfPushBody(t,args,body)== -; if null args -; then body -; else if null rest args -; then pfLambda(first args,t,body) -; else -; pfLambda(first args,pfNothing(), -; pfPushBody(t,rest args,body)) - -(DEFUN |pfPushBody| (|t| |args| |body|) - (PROG () - (RETURN - (COND - ((NULL |args|) |body|) - ((NULL (CDR |args|)) (|pfLambda| (CAR |args|) |t| |body|)) - ('T - (|pfLambda| (CAR |args|) (|pfNothing|) - (|pfPushBody| |t| (CDR |args|) |body|))))))) - -;pfCheckItOut x == -; rt:=if pfTagged? x then pfTaggedExpr x else pfNothing() -; form:= if pfTagged? x then pfTaggedTag x else x -; pfId? form => [pfListOf [pfTyped(form,rt)],nil,rt] -; pfCollect1? form => -; [pfListOf [pfCollectVariable1 form],nil,rt] -; pfTuple? form => -; [pfListOf [pfTaggedToTyped i for i in pf0TupleParts form],nil,rt] -; pfDefinition? form => -; [pfListOf [pfTyped(form,pfNothing())],nil,rt] -; pfApplication? form => -; ls:=pfFlattenApp form -; op:= pfTaggedToTyped1 first ls -; args:=[pfTransformArg i for i in rest ls] -; [pfListOf [op],args,rt] -; npTrapForm form - -(DEFUN |pfCheckItOut| (|x|) - (PROG (|args| |op| |ls| |form| |rt|) - (RETURN - (PROGN - (SETQ |rt| - (COND - ((|pfTagged?| |x|) (|pfTaggedExpr| |x|)) - ('T (|pfNothing|)))) - (SETQ |form| - (COND ((|pfTagged?| |x|) (|pfTaggedTag| |x|)) ('T |x|))) - (COND - ((|pfId?| |form|) - (LIST (|pfListOf| (LIST (|pfTyped| |form| |rt|))) NIL |rt|)) - ((|pfCollect1?| |form|) - (LIST (|pfListOf| (LIST (|pfCollectVariable1| |form|))) NIL - |rt|)) - ((|pfTuple?| |form|) - (LIST (|pfListOf| - ((LAMBDA (|bfVar#6| |bfVar#5| |i|) - (LOOP - (COND - ((OR (ATOM |bfVar#5|) - (PROGN - (SETQ |i| (CAR |bfVar#5|)) - NIL)) - (RETURN (NREVERSE |bfVar#6|))) - ('T - (SETQ |bfVar#6| - (CONS (|pfTaggedToTyped| |i|) - |bfVar#6|)))) - (SETQ |bfVar#5| (CDR |bfVar#5|)))) - NIL (|pf0TupleParts| |form|) NIL)) - NIL |rt|)) - ((|pfDefinition?| |form|) - (LIST (|pfListOf| (LIST (|pfTyped| |form| (|pfNothing|)))) - NIL |rt|)) - ((|pfApplication?| |form|) - (PROGN - (SETQ |ls| (|pfFlattenApp| |form|)) - (SETQ |op| (|pfTaggedToTyped1| (CAR |ls|))) - (SETQ |args| - ((LAMBDA (|bfVar#8| |bfVar#7| |i|) - (LOOP - (COND - ((OR (ATOM |bfVar#7|) - (PROGN (SETQ |i| (CAR |bfVar#7|)) NIL)) - (RETURN (NREVERSE |bfVar#8|))) - ('T - (SETQ |bfVar#8| - (CONS (|pfTransformArg| |i|) - |bfVar#8|)))) - (SETQ |bfVar#7| (CDR |bfVar#7|)))) - NIL (CDR |ls|) NIL)) - (LIST (|pfListOf| (LIST |op|)) |args| |rt|))) - ('T (|npTrapForm| |form|))))))) - ;pfCollect1? x== ; pfApplication? x => ; a:=pfApplicationOp x @@ -652,31 +498,6 @@ ('T NIL)))) ('T NIL))))) -;pfTransformArg args== -; argl:= if pfTuple? args then pf0TupleParts args else [args] -; pfListOf [pfTaggedToTyped1 i for i in argl] - -(DEFUN |pfTransformArg| (|args|) - (PROG (|argl|) - (RETURN - (PROGN - (SETQ |argl| - (COND - ((|pfTuple?| |args|) (|pf0TupleParts| |args|)) - ('T (LIST |args|)))) - (|pfListOf| - ((LAMBDA (|bfVar#10| |bfVar#9| |i|) - (LOOP - (COND - ((OR (ATOM |bfVar#9|) - (PROGN (SETQ |i| (CAR |bfVar#9|)) NIL)) - (RETURN (NREVERSE |bfVar#10|))) - ('T - (SETQ |bfVar#10| - (CONS (|pfTaggedToTyped1| |i|) |bfVar#10|)))) - (SETQ |bfVar#9| (CDR |bfVar#9|)))) - NIL |argl| NIL)))))) - ;pfCheckMacroOut form == ; pfId? form => [form,nil] ; pfApplication? form =>