diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 7ce3824..553fce7 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -656,7 +656,7 @@ information is initialized. \defun{runspad}{runspad} \catches{runspad}{quitTag} \catches{runspad}{coerceFailure} -%\catches{runspad}{top\_level} +\catches{runspad}{top-level} \calls{runspad}{seq} \calls{runspad}{exit} \calls{runspad}{resetStackLimits} @@ -920,7 +920,7 @@ caution. \end{itemize} Notice that all but two paths (a null input or a ``)fi'' or a ``)fin'') will end up as a recursive call to ourselves. -%\throws{intloopReadConsole}{top\_level} +\throws{intloopReadConsole}{top-level} \calls{intloopReadConsole}{serverReadLine} \calls{intloopReadConsole}{leaveScratchpad} \calls{intloopReadConsole}{mkprompt} @@ -1431,8 +1431,8 @@ this is what the current code does so I won't change it. \defunsec{serverReadLine}{READ-LINE in an Axiom server system} \catches{serverReadLine}{coerceFailure} -%\catches{serverReadLine}{top\_level} -%\catches{serverReadLine}{spad\_reader} +\catches{serverReadLine}{top-level} +\catches{serverReadLine}{spad-reader} \calls{serverReadLine}{read-line} \calls{serverReadLine}{addNewInterpreterFrame} \calls{serverReadLine}{sockSendInt} @@ -1569,6 +1569,7 @@ this is what the current code does so I won't change it. \defun{executeQuietCommand}{executeQuietCommand} When \verb|$QuiteCommand| is true Spad will not produce any output from a top level command +\catches{executeQuietCommand}{spad-reader} \catches{executeQuietCommand}{coerceFailure} \catches{executeQuietCommand}{toplevel} \catches{executeQuietCommand}{spadreader} @@ -5410,6 +5411,16 @@ and the current token (\$ttok) @ +\defun{npCommaBackSet}{npCommaBackSet} +\calls{npCommaBackSet}{npEqKey} +<>= +(defun |npCommaBackSet| () + (and + (|npEqKey| 'comma) + (or (|npEqKey| 'backset) t))) + +@ + \defun{npQualifiedDefinition}{npQualifiedDefinition} \calls{npQualifiedDefinition}{npQualified} \calls{npQualifiedDefinition}{npDefinitionOrStatement} @@ -5419,6 +5430,329 @@ and the current token (\$ttok) @ +\defun{npDefinitionOrStatement}{npDefinitionOrStatement} +\calls{npDefinitionOrStatement}{npBackTrack} +\calls{npDefinitionOrStatement}{npGives} +\calls{npDefinitionOrStatement}{npDef} +<>= +(defun |npDefinitionOrStatement| () + (|npBackTrack| #'|npGives| 'def #'|npDef|)) + +@ + +\defun{npGives}{npGives} +\calls{npGives}{npBackTrack} +\calls{npGives}{npExit} +\calls{npGives}{npLambda} +<>= +(defun |npGives| () + (|npBackTrack| #'|npExit| 'gives #'|npLambda|)) + +@ + +\defun{npLambda}{npLambda} +\calls{npLambda}{npVariable} +\calls{npLambda}{npLambda} +\calls{npLambda}{npTrap} +\calls{npLambda}{npPush} +\calls{npLambda}{pfLam} +\calls{npLambda}{npPop2} +\calls{npLambda}{npPop1} +\calls{npLambda}{npEqKey} +\calls{npLambda}{npDefinitionOrStatement} +\calls{npLambda}{npType} +\calls{npLambda}{pfReturnTyped} +<>= +(defun |npLambda| () + (or + (and + (|npVariable|) + (or (|npLambda|) (|npTrap|)) + (|npPush| (|pfLam| (|npPop2|) (|npPop1|)))) + (and + (|npEqKey| 'gives) + (or (|npDefinitionOrStatement|) (|npTrap|))) + (and + (|npEqKey| 'colon) + (or (|npType|) (|npTrap|)) + (|npEqKey| 'gives) + (or (|npDefinitionOrStatement|) (|npTrap|)) + (|npPush| (|pfReturnTyped| (|npPop2|) (|npPop1|)))))) + +@ + +\defun{npType}{npType} +\calls{npType}{npMatch} +\calls{npType}{npPop1} +\calls{npType}{npWith} +\calls{npType}{npPush} +<>= +(defun |npType| () + (and + (|npMatch|) + (let ((a (|npPop1|))) + (or + (|npWith| a) + (|npPush| a))))) + +@ + +\defun{npWith}{npWith} +\calls{npWith}{npEqKey} +\calls{npWith}{npState} +\calls{npWith}{npCategoryL} +\calls{npWith}{npTrap} +\calls{npWith}{npEqPeek} +\calls{npWith}{npRestore} +\calls{npWith}{npVariable} +\calls{npWith}{npCompMissing} +\calls{npWith}{npPush} +\calls{npWith}{pfWith} +\calls{npWith}{npPop2} +\calls{npWith}{npPop1} +\calls{npWith}{pfNothing} +<>= +(defun |npWith| (extra) + (let (a) + (and + (|npEqKey| 'with) + (progn + (setq a (|npState|)) + (or (|npCategoryL|) (|npTrap|)) + (if (|npEqPeek| 'in) + (progn + (|npRestore| a) + (and + (or (|npVariable|) (|npTrap|)) + (|npCompMissing| 'in) + (or (|npCategoryL|) (|npTrap|)) + (|npPush| (|pfWith| (|npPop2|) (|npPop1|) extra)))) + (|npPush| (|pfWith| (|pfNothing|) (|npPop1|) extra))))))) + +@ + +\defun{npCompMissing}{npCompMissing} +\calls{npCompMissing}{npEqKey} +\calls{npCompMissing}{npMissing} +<>= +(defun |npCompMissing| (s) + (or (|npEqKey| s) (|npMissing| s))) + +@ + +\defun{npMissing}{npMissing} +\throws{npMissing}{trappoint} +\calls{npMissing}{ncSoftError} +\calls{npMissing}{tokPosn} +\calls{npMissing}{pname} +\usesdollar{npMissing}{stok} +<>= +(defun |npMissing| (s) + (declare (special |$stok|)) + (|ncSoftError| (|tokPosn| |$stok|) 'S2CY0007 (list (pname s))) + (throw 'trappoint 'trapped))))) + +@ + +\defun{npRestore}{npRestore} +\calls{npRestore}{npFirstTok} +\usesdollar{npRestore}{stack} +\usesdollar{npRestore}{inputStream} +<>= +(defun |npRestore| (x) + (declare (special |$stack| |$inputStream|)) + (setq |$inputStream| (car x)) + (|npFirstTok|) + (setq |$stack| (cdr x)) + t) + +@ + +\defun{npEqPeek}{Peek for keyword s, no advance of token stream} +\usesdollar{npEqPeek}{ttok} +\usesdollar{npEqPeek}{stok} +<>= +(defun |npEqPeek| (s) + (declare (special |$ttok| |$stok|)) + (and (eq (caar |$stok|) '|key|) (eq s |$ttok|))) + +@ + +\defun{npCategoryL}{npCategoryL} +\calls{npCategoryL}{npCategory} +\calls{npCategoryL}{npPush} +\calls{npCategoryL}{pfUnSequence} +\calls{npCategoryL}{npPop1} +<>= +(defun |npCategoryL| () + (and + (|npCategory|) + (|npPush| (|pfUnSequence| (|npPop1|))))) + +@ + +\defun{npCategory}{npCategory} +\calls{npCategory}{npPP} +\calls{npCategory}{npSCategory} +<>= +(defun |npCategory| () + (|npPP| #'|npSCategory|)) + +@ + +\defun{npSCategory}{npSCategory} +\calls{npSCategory}{npWConditional} +\calls{npSCategory}{npCategoryL} +\calls{npSCategory}{npPush} +\calls{npSCategory}{npPop1} +\calls{npSCategory}{npDefaultValue} +\calls{npSCategory}{npState} +\calls{npSCategory}{npPrimary} +\calls{npSCategory}{npEqPeek} +\calls{npSCategory}{npRestore} +\calls{npSCategory}{npSignature} +\calls{npSCategory}{npApplication} +\calls{npSCategory}{pfAttribute} +\calls{npSCategory}{npTrap} +<>= +(defun |npSCategory| () + (let (a) + (cond + ((|npWConditional| #'|npCategoryL|) (|npPush| (list (|npPop1|)))) + ((|npDefaultValue|) t) + (t + (setq a (|npState|)) + (cond + ((|npPrimary|) + (cond + ((|npEqPeek| 'colon) (|npRestore| a) (|npSignature|)) + (t + (|npRestore| a) + (or + (and (|npApplication|) (|npPush| (list (|pfAttribute| (|npPop1|))))) + (|npTrap|))))) + (t nil)))))) + +@ + +\defun{npWConditional}{npWConditional} +\calls{npWConditional}{npConditional} +\calls{npWConditional}{npPush} +\calls{npWConditional}{pfTweakIf} +\calls{npWConditional}{npPop1} +<>= +(defun |npWConditional| (f) + (when (|npConditional| f) (|npPush| (|pfTweakIf| (|npPop1|))))) + +@ + +\defvar{npPParg} +<>= +(defvar *npPParg* nil "rewrite npPP without flets, using global scoping") + +@ + +\defun{npPP}{npPP} +This was rewritten by NAG to remove flet. +\calls{npPP}{npParened} +\calls{npPP}{npPPf} +\calls{npPP}{npPileBracketed} +\calls{npPP}{npPPg} +\calls{npPP}{npPush} +\calls{npPP}{pfEnSequence} +\calls{npPP}{npPop1} +\uses{npPP}{npPParg} +<>= +(defun |npPP| (f) + (declare (special *npPParg*)) + (setq *npPParg* f) + (or + (|npParened| #'npPPf) + (and (|npPileBracketed| #'npPPg) (|npPush| (|pfEnSequence| (|npPop1|)))) + (funcall f))) + +@ + +\defun{npPPff}{npPPff} +\calls{npPPff}{npPop1} +\calls{npPPff}{npPush} +\usesdollar{npPPff}{npPParg} +<>= +(defun npPPff () + (and (funcall *npPParg*) (|npPush| (list (|npPop1|))))) + +@ + +\defun{npPPg}{npPPg} +\calls{npPPg}{npListAndRecover} +\calls{npPPg}{npPPf} +\calls{npPPg}{npPush} +\calls{npPPg}{pfAppend} +\calls{npPPg}{npPop1} +<>= +(defun npPPg () + (and (|npListAndRecover| #'npPPf)) + (|npPush| (|pfAppend| (|npPop1|)))) + +@ + +\defun{npPPf}{npPPf} +\calls{npPPf}{npSemiListing} +\calls{npPPf}{npPPff} +<>= +(defun npPPf () + (|npSemiListing| #'npPPff)) + +@ + +\defun{npState}{npState} +\usesdollar{npState}{stack} +\usesdollar{npState}{inputStream} +<>= +(defun |npState| () + (declare (special |$stack| |$inputStream|)) + (cons |$inputStream| |$stack|)) + +@ + +\defun{npTrap}{npTrap} +\throws{npTrap}{trappoint} +\calls{npTrap}{tokPosn} +\calls{npTrap}{ncSoftError} +\usesdollar{npTrap}{stok} +<>= +(defun |npTrap| () + (declare (special |$stok|)) + (|ncSoftError| (|tokPosn| |$stok|) 'S2CY0002 nil) + (throw 'trappoint 'trapped)) + +@ + +\defun{npVariable}{npVariable} +\calls{npVariable}{npParenthesized} +\calls{npVariable}{npVariablelist} +\calls{npVariable}{npVariableName} +\calls{npVariable}{npPush} +\calls{npVariable}{pfListOf} +\calls{npVariable}{npPop1} +<>= +(defun |npVariable| () + (or + (|npParenthesized| #'|npVariablelist|) + (and (|npVariableName|) (|npPush| (|pfListOf| (list (|npPop1|))))))) + +@ + +\defun{npExit}{npExit} +\calls{npExit}{npBackTrack} +\calls{npExit}{npAssign} +\calls{npExit}{npPileExit} +<>= +(defun |npExit| () + (|npBackTrack| #'|npAssign| 'exit #'|npPileExit|)) + +@ + \defun{npListofFun}{npListofFun} \calls{npListofFun}{npTrap} \calls{npListofFun}{npPush} @@ -5457,6 +5791,14 @@ and the current token (\$ttok) @ +\defun{pfNothing}{pfNothing} +\calls{pfNothing}{pfTree} +<>= +(defun |pfNothing| () + (|pfTree| '|nothing| nil)) + +@ + \defun{pfNothing?}{Is this a Nothing node?} \calls{pfNothing?}{pfAbSynOp?} <>= @@ -5602,6 +5944,13 @@ and the current token (\$ttok) @ +\defun{pfAppend}{Flatten a list of lists} +<>= +(defun |pfAppend| (list) + (apply #'append list)) + +@ + \defun{pfApplication?}{Is this an Application node?} \calls{pfApplication?}{pfAbSynOp?} <>= @@ -5781,6 +6130,13 @@ and the current token (\$ttok) @ +\defun{pfFirst}{pfFirst} +<>= +(defun |pfFirst| (form) + (cadr form)) + +@ + \defun{pfFree?}{Is this a Free node?} \calls{pfFree?}{pfAbSynOp?} <>= @@ -5895,6 +6251,33 @@ and the current token (\$ttok) @ +\defun{pfLam}{pfLam} +\calls{pfLam}{pfAbSynOp?} +\calls{pfLam}{pfFirst} +\calls{pfLam}{pfNothing} +\calls{pfLam}{pfSecond} +\calls{pfLam}{pfLambda} +<>= +(defun |pfLam| (variable body) + (let (bdy rets) + (if (|pfAbSynOp?| body '|returntyped|) + (setq rets (|pfFirst| body)) + (setq rets (|pfNothing|))) + (if (|pfAbSynOp?| body '|returntyped|) + (setq bdy (|pfSecond| body)) + (setq bdy body)) + (|pfLambda| variable rets bdy))) + +@ + +\defun{pfLambda}{pfLambda} +\calls{pfLambda}{pfTree} +<>= +(defun |pfLambda| (pfargs pfrets pfbody) + (|pfTree| '|Lambda| (list pfargs pfrets pfbody))) + +@ + \defun{pfLambdaBody}{Return the Body part of a Lambda node} <>= (defun |pfLambdaBody| (pf) @@ -5917,6 +6300,13 @@ and the current token (\$ttok) @ +\defun{pfLambdaArgs}{Return the Args part of a Lambda node} +<>= +(defun |pfLambdaArgs| (pf) + (cadr pf)) + +@ + \defun{pf0LambdaArgs}{Return the Args of a Lambda Node} \calls{pf0LambdaArgs}{pfParts} \calls{pf0LambdaArgs}{pfLambdaArgs} @@ -6109,6 +6499,14 @@ and the current token (\$ttok) @ +\defun{pfReturnTyped}{Construct a ReturnTyped node} +\calls{pfReturnTyped}{pfTree} +<>= +(defun |pfReturnTyped| (type body) + (|pfTree| '|returntyped| (list type body))) + +@ + \defun{pfRule}{Construct a Rule node} \calls{pfRule}{pfTree} <>= @@ -6139,6 +6537,13 @@ and the current token (\$ttok) @ +\defun{pfSecond}{pfSecond} +<>= +(defun |pfSecond| (form) + (caddr form)) + +@ + \defun{pfSequence}{Construct a Sequence node} \calls{pfSequence}{pfTree} <>= @@ -6147,6 +6552,13 @@ and the current token (\$ttok) @ +\defun{pfSequenceArgs}{Return the Args of a Sequence node} +<>= +(defun |pfSequenceArgs| (pf) + (cadr pf)) + +@ + \defun{pfSequence?}{ Is this a Sequence node?} \calls{pfSequence?}{pfAbSynOp?} <>= @@ -6155,6 +6567,15 @@ and the current token (\$ttok) @ +\defun{pf0SequenceArgs}{Return the parts of the Args of a Sequence node} +\calls{pf0SequenceArgs}{pfParts} +\calls{pf0SequenceArgs}{pfSequenceArgs} +<>= +(defun |pf0SequenceArgs| (pf) + (|pfParts| (|pfSequenceArgs| pf))) + +@ + \defun{pfSuchthat?}{Is this a SuchThat node?} \calls{pfSuchthat?}{pfAbSynOp?} <>= @@ -6255,6 +6676,19 @@ and the current token (\$ttok) @ +\defun{pfUnSequence}{Return a list from a Sequence node} +\calls{pfUnSequence}{pfSequence?} +\calls{pfUnSequence}{pfAppend} +\calls{pfUnSequence}{pf0SequenceArgs} +\calls{pfUnSequence}{pfListOf} +<>= +(defun |pfUnSequence| (x) + (if (|pfSequence?| x) + (|pfListOf| (|pfAppend| (|pf0SequenceArgs| x))) + (|pfListOf| x))) + +@ + \defun{pfWhere?}{Is this a Where node?} \calls{pfWhere?}{pfAbSynOp?} <>= @@ -18829,7 +19263,7 @@ args arguments for compiling AXIOM code ((or (null arg) (eq arg '|%describe%|) (eq (car arg) '?) (/= (|#| arg) 1)) (|describeOutputLibraryArgs|)) (t - (when (filep (setq fn (princ-to-string (car arg)))) + (when (probe-file (setq fn (princ-to-string (car arg)))) (setq fn (truename fn))) (|openOutputLibrary| (setq |$outputLibraryName| fn)))))) @@ -27611,8 +28045,8 @@ This tests if x is an identifier beginning with \verb|#| followed by a number. This tests if x is an identifier beginning with \verb|#| \calls{isSharpVar}{identp} <>= -(defun |isSharpVar| (|x|) - (and (identp |x|) (char= (schar (symbol-name |x|) 0) #\#))) +(defun |isSharpVar| (x) + (and (identp x) (char= (schar (symbol-name x) 0) #\#))) @ @@ -29918,7 +30352,7 @@ o )library @ \defun{spad}{spad} -%\catches{spad\_reader} +\catches{spad-reader} \calls{spad}{addBinding} \calls{spad}{makeInitialModemapFrame} \calls{spad}{init-boot/spad-reader} @@ -34062,6 +34496,8 @@ for example: @ \defun{monitor-file}{Hang a monitor call on all of the defuns in a file} +\catches{monitor-file}{done} +\throws{monitor-file}{done} \calls{monitor-file}{monitor-add} <>= (defun monitor-file (file) @@ -34346,6 +34782,8 @@ for example: \tpdhere{note that the file interp.exposed no longer exists.} The exposure information is now in bookvol5. This needs to work off the internal exposure list, not the file. +\catches{monitor-readinterp}{done} +\throws{monitor-readinterp}{done} \uses{monitor-readinterp}{*monitor-domains*} <>= (defun monitor-readinterp () @@ -34435,6 +34873,8 @@ This needs to work off the internal exposure list, not the file. @ \defun{monitor-spadfile}{Given a spad file, report all nrlibs it creates} +\catches{monitor-spadfile}{done} +\throws{monitor-spadfile}{done} \calls{monitor-spadfile}{monitor-parse} \uses{monitor-spadfile}{*monitor-domains*} <>= @@ -35021,26 +35461,48 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> +<> <> +<> +<> +<> <> +<> +<> <> +<> <> <> +<> <> <> +<> <> <> <> <> <> <> +<> +<> +<> +<> <> <> <> <> +<> +<> <> <> +<> +<> <> +<> +<> +<> +<> <> <> @@ -35068,6 +35530,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -35096,6 +35559,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -35111,6 +35575,9 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> +<> +<> <> <> <> @@ -35135,6 +35602,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -35152,13 +35620,16 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> <> <> <> +<> <> +<> <> <> <> @@ -35178,6 +35649,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -35192,6 +35664,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> diff --git a/changelog b/changelog index 85bb211..28954e8 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,9 @@ +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 +20100214 tpd src/interp/ptrees.lisp treeshake +20100214 tpd src/interp/cparse.lisp treeshake +20100214 tpd books/bookvol5 treeshake cparse, ptrees, serror, vmlisp 20100213 tpd src/axiom-website/patches.html 20100213.01.tpd.patch 20100213 tpd src/interp/ptrees.lisp treeshake 20100213 tpd books/bookvol5 treeshake ptrees.lisp diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 4620107..5a3dee3 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2453,5 +2453,7 @@ books/bookvol5 merge and remove pf2sex
books/bookvol10.1 add quaternion quote from Altmann
20100213.01.tpd.patch books/bookvol5 treeshake ptrees.lisp
+20100214.01.tpd.patch +books/bookvol5 treeshake cparse, ptrees, serror, vmlisp
diff --git a/src/interp/cparse.lisp.pamphlet b/src/interp/cparse.lisp.pamphlet index b945206..3addd2c 100644 --- a/src/interp/cparse.lisp.pamphlet +++ b/src/interp/cparse.lisp.pamphlet @@ -17,31 +17,6 @@ ;-- rhs of assignment changed from npStatement to npGives ; -;npNext() == -; $inputStream := CDR($inputStream) -; npFirstTok() - -;npState()==cons($inputStream,$stack) -(DEFUN |npState| () - (PROG NIL - (DECLARE (SPECIAL |$stack| |$inputStream|)) - (RETURN - (CONS |$inputStream| |$stack|)))) - -;npRestore(x)== -; $inputStream:=CAR x -; npFirstTok() -; $stack:=CDR x -; true -(DEFUN |npRestore| (|x|) - (PROG NIL - (DECLARE (SPECIAL |$stack| |$inputStream|)) - (RETURN - (PROGN - (SETQ |$inputStream| (CAR |x|)) - (|npFirstTok|) - (SETQ |$stack| (CDR |x|)) T)))) - ;npPushId()== ; a:=GET($ttok,'INFGENERIC) ; $ttok:= if a then a else $ttok @@ -507,40 +482,7 @@ ((|npEqKey| (QUOTE BACKSET)) (|npEqKey| (QUOTE ELSE))) ((QUOTE T) (|npEqKey| (QUOTE ELSE))))))) -;npWConditional f== -; if npConditional f -; then npPush pfTweakIf npPop1() -; else false -(DEFUN |npWConditional| (|f|) - (PROG NIL - (RETURN - (COND - ((|npConditional| |f|) (|npPush| (|pfTweakIf| (|npPop1|)))) - ((QUOTE T) NIL))))) - ;-- Parsing functions -; -;-- peek for keyword s, no advance of token stream -; -;npEqPeek s == EQ(CAAR $stok,"key") and EQ(s,$ttok) -(DEFUN |npEqPeek| (|s|) - (PROG NIL - (DECLARE (SPECIAL |$ttok| |$stok|)) - (RETURN - (AND (EQ (CAAR |$stok|) (QUOTE |key|)) (EQ |s| |$ttok|))))) - -;-- test for keyword s, if found advance token stream -; -;npEqKey s == -; EQ(CAAR $stok,"key") and EQ(s,$ttok) and npNext() -(DEFUN |npEqKey| (|s|) - (PROG NIL - (DECLARE (SPECIAL |$ttok| |$stok|)) - (RETURN - (AND - (EQ (CAAR |$stok|) (QUOTE |key|)) - (EQ |s| |$ttok|) - (|npNext|))))) ;$npTokToNames:= ["~","#","[]","{}", "[||]","{||}"] (EVAL-WHEN (EVAL LOAD) @@ -1066,20 +1008,6 @@ (RETURN (|npLeftAssoc| (QUOTE (IS ISNT)) (FUNCTION |npSuch|))))) -;npType() == npMatch() and -; a:=npPop1() -; npWith(a) or npPush a -(DEFUN |npType| () - (PROG (|a|) - (RETURN - (AND - (|npMatch|) - (PROGN - (SETQ |a| (|npPop1|)) - (OR - (|npWith| |a|) - (|npPush| |a|))))))) - ;npADD() == npType() and ; a:=npPop1() ; npAdd(a) or npPush a @@ -1106,14 +1034,6 @@ (RETURN (OR (|npConditionalStatement|) (|npADD|))))) -;npCommaBackSet()== npEqKey "COMMA" and (npEqKey "BACKSET" or true) -(DEFUN |npCommaBackSet| () - (PROG NIL - (RETURN - (AND - (|npEqKey| (QUOTE COMMA)) - (OR (|npEqKey| (QUOTE BACKSET)) T))))) - ;npExpress()== ; npExpress1() and ; (npIterators() and @@ -1302,12 +1222,6 @@ (RETURN (|npListing| (FUNCTION |npAssignVariableName|))))) -;npExit()== npBackTrack(function npAssign,"EXIT",function npPileExit) -(DEFUN |npExit| () - (PROG NIL - (RETURN - (|npBackTrack| (FUNCTION |npAssign|) 'EXIT (FUNCTION |npPileExit|))))) - ;npPileExit()== ; npAssign() and (npEqKey "EXIT" or npTrap()) and ; (npStatement() or npTrap()) @@ -1321,19 +1235,6 @@ (OR (|npStatement|) (|npTrap|)) (|npPush| (|pfExit| (|npPop2|) (|npPop1|))))))) -;npGives()== npBackTrack(function npExit,"GIVES",function npLambda) -(DEFUN |npGives| () - (PROG NIL - (RETURN - (|npBackTrack| (FUNCTION |npExit|) (QUOTE GIVES) (FUNCTION |npLambda|))))) - -;npDefinitionOrStatement()== -; npBackTrack(function npGives,"DEF",function npDef) -(DEFUN |npDefinitionOrStatement| () - (PROG NIL - (RETURN - (|npBackTrack| (FUNCTION |npGives|) (QUOTE DEF) (FUNCTION |npDef|))))) - ;npVoid()== npAndOr("DO",function npStatement,function pfNovalue) (DEFUN |npVoid| () (PROG NIL @@ -1615,99 +1516,6 @@ (OR (|npDefinitionOrStatement|) (|npTrap|)) (|npPush| (LIST (|pfAdd| (|pfNothing|) (|npPop1|) (|pfNothing|)))))))) -;npWith(extra)== -; npEqKey "WITH" and -; a:=npState() -; npCategoryL() or npTrap() -; npEqPeek "IN" => -; npRestore a -; (npVariable() or npTrap()) and -; npCompMissing "IN" and -; (npCategoryL() or npTrap()) and -; npPush pfWith(npPop2(),npPop1(),extra) -; npPush pfWith(pfNothing(),npPop1(),extra) -(DEFUN |npWith| (|extra|) - (PROG (|a|) - (RETURN - (AND - (|npEqKey| (QUOTE WITH)) - (PROGN - (SETQ |a| (|npState|)) - (OR (|npCategoryL|) (|npTrap|)) - (COND - ((|npEqPeek| (QUOTE IN)) - (PROGN - (|npRestore| |a|) - (AND - (OR (|npVariable|) (|npTrap|)) - (|npCompMissing| (QUOTE IN)) - (OR (|npCategoryL|) (|npTrap|)) - (|npPush| (|pfWith| (|npPop2|) (|npPop1|) |extra|))))) - ((QUOTE T) (|npPush| (|pfWith| (|pfNothing|) (|npPop1|) |extra|))))))))) - -;npCategoryL()== npCategory() and npPush pfUnSequence npPop1 () -(DEFUN |npCategoryL| () - (PROG NIL - (RETURN - (AND - (|npCategory|) - (|npPush| (|pfUnSequence| (|npPop1|))))))) - -;pfUnSequence x== -; pfSequence? x => pfListOf pfAppend pf0SequenceArgs x -; pfListOf x -(DEFUN |pfUnSequence| (|x|) - (PROG NIL - (RETURN - (COND - ((|pfSequence?| |x|) (|pfListOf| (|pfAppend| (|pf0SequenceArgs| |x|)))) - ((QUOTE T) (|pfListOf| |x|)))))) - -;npCategory()== npPP function npSCategory -(DEFUN |npCategory| () - (PROG NIL - (RETURN - (|npPP| (FUNCTION |npSCategory|))))) - -;npSCategory()== -; if npWConditional function npCategoryL -; then npPush [npPop1()] -; else -; if npDefaultValue() -; then true -; else -; a:=npState() -; if npPrimary() -; then if npEqPeek "COLON" -; then -; npRestore a -; npSignature() -; else -; npRestore a -; npApplication() and npPush [pfAttribute (npPop1())] -; or npTrap() -; -; else false -(DEFUN |npSCategory| () - (PROG (|a|) - (RETURN - (COND - ((|npWConditional| (FUNCTION |npCategoryL|)) (|npPush| (LIST (|npPop1|)))) - ((|npDefaultValue|) T) - (#0=(QUOTE T) - (SETQ |a| (|npState|)) - (COND - ((|npPrimary|) - (COND - ((|npEqPeek| (QUOTE COLON)) (|npRestore| |a|) (|npSignature|)) - (#0# - (|npRestore| |a|) - (OR - (AND (|npApplication|) (|npPush| (LIST (|pfAttribute| (|npPop1|))))) - (|npTrap|))))) - (#0# NIL))))))) - -; ;npSignatureDefinee()== ; npName() or npInfixOperator() or npPrefixColon() (DEFUN |npSignatureDefinee| () @@ -1781,15 +1589,6 @@ (|npName|) (OR (|npDecl|) (|npPush| (|pfTyped| (|npPop1|) (|pfNothing|)))))))) -;npVariable()== npParenthesized function npVariablelist or -; (npVariableName() and npPush pfListOf [npPop1()]) -(DEFUN |npVariable| () - (PROG NIL - (RETURN - (OR - (|npParenthesized| (FUNCTION |npVariablelist|)) - (AND (|npVariableName|) (|npPush| (|pfListOf| (LIST (|npPop1|))))))))) - ;npVariablelist()== npListing function npVariableName (DEFUN |npVariablelist| () (PROG NIL @@ -1978,34 +1777,6 @@ (|npPileBracketed| (FUNCTION |npPileDefinitionlist|)) (|npPush| (|pfSequence| (|pfListOf| (|npPop1|)))))))) -; -;npLambda()== -; (npVariable() and -; ((npLambda() or npTrap()) and -; npPush pfLam(npPop2(),npPop1()))) or -; npEqKey "GIVES" and (npDefinitionOrStatement() or npTrap()) or -; npEqKey "COLON" and (npType() or npTrap()) and -; npEqKey "GIVES" and (npDefinitionOrStatement() or npTrap()) -; and -; npPush pfReturnTyped(npPop2(),npPop1()) -(DEFUN |npLambda| () - (PROG NIL - (RETURN - (OR - (AND - (|npVariable|) - (OR (|npLambda|) (|npTrap|)) - (|npPush| (|pfLam| (|npPop2|) (|npPop1|)))) - (AND - (|npEqKey| (QUOTE GIVES)) - (OR (|npDefinitionOrStatement|) (|npTrap|))) - (AND - (|npEqKey| (QUOTE COLON)) - (OR (|npType|) (|npTrap|)) - (|npEqKey| (QUOTE GIVES)) - (OR (|npDefinitionOrStatement|) (|npTrap|)) - (|npPush| (|pfReturnTyped| (|npPop2|) (|npPop1|)))))))) - ;npDef()== ; npMatch() => ; [op,arg,rt]:= pfCheckItOut(npPop1()) diff --git a/src/interp/ptrees.lisp.pamphlet b/src/interp/ptrees.lisp.pamphlet index 26a87bf..4cf2317 100644 --- a/src/interp/ptrees.lisp.pamphlet +++ b/src/interp/ptrees.lisp.pamphlet @@ -29,44 +29,6 @@ (DEFUN |pfLeafPosition| (|form|) (PROG () (RETURN (|tokPosn| |form|)))) -;pfFirst form == CADR form -- was ==> - -(DEFUN |pfFirst| (|form|) (PROG () (RETURN (CADR |form|)))) - -;pfSecond form == CADDR form -- was ==> - -(DEFUN |pfSecond| (|form|) (PROG () (RETURN (CADDR |form|)))) - -;--% SPECIAL NODES -;pfListOf? x == pfAbSynOp?(x,'listOf) - -(DEFUN |pfListOf?| (|x|) - (PROG () (RETURN (|pfAbSynOp?| |x| '|listOf|)))) - -;pfAppend list == APPLY(function APPEND,list) - -(DEFUN |pfAppend| (LIST) (PROG () (RETURN (APPLY #'APPEND LIST)))) - -;pfNothing () == pfTree('nothing, []) - -(DEFUN |pfNothing| () (PROG () (RETURN (|pfTree| '|nothing| NIL)))) - -;-- SemiColon -; -;pfSemiColon(pfbody) == pfTree('SemiColon, [pfbody]) - -(DEFUN |pfSemiColon| (|pfbody|) - (PROG () (RETURN (|pfTree| '|SemiColon| (LIST |pfbody|))))) - -;pfSemiColon?(pf) == pfAbSynOp? (pf, 'SemiColon) - -(DEFUN |pfSemiColon?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|SemiColon|)))) - -;pfSemiColonBody pf == CADR pf -- was ==> - -(DEFUN |pfSemiColonBody| (|pf|) (PROG () (RETURN (CADR |pf|)))) - ;--% LEAVES ;pfId(expr) == pfLeaf('id, expr) @@ -77,40 +39,12 @@ (DEFUN |pfIdPos| (|expr| |pos|) (PROG () (RETURN (|pfLeaf| '|id| |expr| |pos|)))) -;pfSymbolVariable? form == pfAbSynOp?(form,'idsy) - -(DEFUN |pfSymbolVariable?| (|form|) - (PROG () (RETURN (|pfAbSynOp?| |form| '|idsy|)))) - -;--pfAmpersand(amptok,name) == name -; - -;pfDocument? form == pfAbSynOp?(form, 'Document) - -(DEFUN |pfDocument?| (|form|) - (PROG () (RETURN (|pfAbSynOp?| |form| '|Document|)))) - -;pfDocumentText form == tokPart form - -(DEFUN |pfDocumentText| (|form|) - (PROG () (RETURN (|tokPart| |form|)))) - -;pfStringConstString form == tokPart form - -(DEFUN |pfStringConstString| (|form|) - (PROG () (RETURN (|tokPart| |form|)))) - ;pfExpression(expr, :optpos) == ; pfLeaf("expression", expr, IFCAR optpos) (DEFUN |pfExpression| (|expr| &REST |optpos|) (PROG () (RETURN (|pfLeaf| '|expression| |expr| (IFCAR |optpos|))))) -;pfExpression? form == pfAbSynOp?(form, 'expression) - -(DEFUN |pfExpression?| (|form|) - (PROG () (RETURN (|pfAbSynOp?| |form| '|expression|)))) - ;pfSymbol(expr, :optpos) == ; pfLeaf("symbol", expr, IFCAR optpos) @@ -196,21 +130,6 @@ (DEFUN |pfCheckInfop| (|form|) (PROG () (RETURN NIL))) -;pfAnd(pfleft, pfright) == pfTree('And, [pfleft, pfright]) - -(DEFUN |pfAnd| (|pfleft| |pfright|) - (PROG () (RETURN (|pfTree| '|And| (LIST |pfleft| |pfright|))))) - -;pfOr(pfleft, pfright) == pfTree('Or, [pfleft, pfright]) - -(DEFUN |pfOr| (|pfleft| |pfright|) - (PROG () (RETURN (|pfTree| '|Or| (LIST |pfleft| |pfright|))))) - -;pfNot(arg) == pfTree('Not, [arg]) - -(DEFUN |pfNot| (|arg|) - (PROG () (RETURN (|pfTree| '|Not| (LIST |arg|))))) - ;pfFromDom(dom,expr)== ; if pfApplication? expr ; then pfApplication(pfFromdom(pfApplicationOp expr,dom), @@ -228,58 +147,6 @@ (|pfApplicationArg| |expr|))) ('T (|pfFromdom| |expr| |dom|)))))) -;pfReturnTyped(type,body)==pfTree('returntyped,[type,body]) -; - -(DEFUN |pfReturnTyped| (|type| |body|) - (PROG () (RETURN (|pfTree| '|returntyped| (LIST |type| |body|))))) - -;pfLam(variable,body)==-- called from parser -; rets:= if pfAbSynOp?(body,'returntyped) -; then pfFirst body -; else pfNothing () -; bdy:= if pfAbSynOp?(body,'returntyped) then pfSecond body else body -; pfLambda(variable,rets,bdy) - -(DEFUN |pfLam| (|variable| |body|) - (PROG (|bdy| |rets|) - (RETURN - (PROGN - (SETQ |rets| - (COND - ((|pfAbSynOp?| |body| '|returntyped|) - (|pfFirst| |body|)) - ('T (|pfNothing|)))) - (SETQ |bdy| - (COND - ((|pfAbSynOp?| |body| '|returntyped|) - (|pfSecond| |body|)) - ('T |body|))) - (|pfLambda| |variable| |rets| |bdy|))))) - -;pfTLam(variable,body)==-- called from parser -; rets:= if pfAbSynOp?(body,'returntyped) -; then pfFirst body -; else pfNothing () -; bdy:= if pfAbSynOp?(body,'returntyped) then pfSecond body else body -; pfTLambda(variable,rets,bdy) - -(DEFUN |pfTLam| (|variable| |body|) - (PROG (|bdy| |rets|) - (RETURN - (PROGN - (SETQ |rets| - (COND - ((|pfAbSynOp?| |body| '|returntyped|) - (|pfFirst| |body|)) - ('T (|pfNothing|)))) - (SETQ |bdy| - (COND - ((|pfAbSynOp?| |body| '|returntyped|) - (|pfSecond| |body|)) - ('T |body|))) - (|pfTLambda| |variable| |rets| |bdy|))))) - ;pfIfThenOnly(pred,first)==pfIf(pred,first,pfNothing()) (DEFUN |pfIfThenOnly| (|pred| CAR) @@ -299,11 +166,6 @@ (DEFUN |pfLoop1| (|body|) (PROG () (RETURN (|pfLoop| (|pfListOf| (LIST (|pfDo| |body|))))))) -;pfExitNoCond value== pfExit(pfNothing(),value) - -(DEFUN |pfExitNoCond| (|value|) - (PROG () (RETURN (|pfExit| (|pfNothing|) |value|)))) - ;pfReturnNoName(value)==pfReturn(value,pfNothing()) (DEFUN |pfReturnNoName| (|value|) @@ -340,14 +202,6 @@ (DEFUN |pfHide| (|a| |part|) (PROG () (RETURN (|pfTree| '|Hide| (LIST |part|))))) -;pfHide? x== pfAbSynOp?(x,"Hide") - -(DEFUN |pfHide?| (|x|) (PROG () (RETURN (|pfAbSynOp?| |x| '|Hide|)))) - -;pfHidePart x== CADR x - -(DEFUN |pfHidePart| (|x|) (PROG () (RETURN (CADR |x|)))) - ;pfParen(a,part)==part (DEFUN |pfParen| (|a| |part|) (PROG () (RETURN |part|))) @@ -371,11 +225,6 @@ (SETQ |bfVar#3| (CDR |bfVar#3|)))) NIL |l| NIL)))) -;pfTupleList form== pfParts pfTupleParts form - -(DEFUN |pfTupleList| (|form|) - (PROG () (RETURN (|pfParts| (|pfTupleParts| |form|))))) - ;--The rest have been generated from ABCUT INPUT ;-- 1/31/89 ; @@ -422,51 +271,6 @@ ; pfWhere? pf or _ ; pfWith? pf -(DEFUN |pfExpr?| (|pf|) - (PROG () - (RETURN - (OR (|pfAdd?| |pf|) (|pfApplication?| |pf|) (|pfAssign?| |pf|) - (|pfCoerceto?| |pf|) (|pfCollect?| |pf|) - (|pfComDefinition?| |pf|) (|pfDeclPart?| |pf|) - (|pfExit?| |pf|) (|pfExport?| |pf|) (|pfFree?| |pf|) - (|pfFromdom?| |pf|) (|pfId?| |pf|) (|pfIf?| |pf|) - (|pfInline?| |pf|) (|pfIterate?| |pf|) (|pfLambda?| |pf|) - (|pfBreak?| |pf|) (|pfLiteral?| |pf|) (|pfLocal?| |pf|) - (|pfLoop?| |pf|) (|pfMLambda?| |pf|) (|pfPretend?| |pf|) - (|pfRestrict?| |pf|) (|pfReturn?| |pf|) (|pfSequence?| |pf|) - (|pfTagged?| |pf|) (|pfTuple?| |pf|) (|pfTyping?| |pf|) - (|pfWhere?| |pf|) (|pfWith?| |pf|))))) - -;pfDeclPart? pf == -; pfTyping? pf or _ -; pfImport? pf or _ -; pfDefinition? pf or _ -; pfSequence? pf or _ -; pfDWhere? pf or _ -; pfMacro? pf - -(DEFUN |pfDeclPart?| (|pf|) - (PROG () - (RETURN - (OR (|pfTyping?| |pf|) (|pfImport?| |pf|) (|pfDefinition?| |pf|) - (|pfSequence?| |pf|) (|pfDWhere?| |pf|) (|pfMacro?| |pf|))))) - -;-- Wrong := (Why: Document, Rubble: [Expr]) - -;pfWrongWhy pf == CADR pf -- was ==> - -(DEFUN |pfWrongWhy| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pfWrongRubble pf == CADDR pf -- was ==> - -(DEFUN |pfWrongRubble| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - -;pf0WrongRubble pf == pfParts pfWrongRubble pf - -(DEFUN |pf0WrongRubble| (|pf|) - (PROG () (RETURN (|pfParts| (|pfWrongRubble| |pf|))))) - - ;-- Add := (Base: [Typed], Addin: Expr) ;pfAdd(pfbase, pfaddin,:addon) == @@ -482,47 +286,6 @@ (SETQ |lhs| (COND (|addon| (CAR |addon|)) ('T (|pfNothing|)))) (|pfTree| '|Add| (LIST |pfbase| |pfaddin| |lhs|)))))) -;pfAdd?(pf) == pfAbSynOp? (pf, 'Add) - -(DEFUN |pfAdd?| (|pf|) (PROG () (RETURN (|pfAbSynOp?| |pf| '|Add|)))) - -;pfAddBase pf == CADR pf -- was ==> - -(DEFUN |pfAddBase| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pfAddAddin pf == CADDR pf -- was ==> - -(DEFUN |pfAddAddin| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - -;pfAddAddon pf == CADDDR pf -- was ==> - -(DEFUN |pfAddAddon| (|pf|) (PROG () (RETURN (CADDDR |pf|)))) - -;pf0AddBase pf == pfParts pfAddBase pf - -(DEFUN |pf0AddBase| (|pf|) - (PROG () (RETURN (|pfParts| (|pfAddBase| |pf|))))) - -;-- DWhere := (Context: [DeclPart], Expr: [DeclPart]) - -;pfDWhere(pfcontext, pfexpr) == pfTree('DWhere, [pfcontext, pfexpr]) - -(DEFUN |pfDWhere| (|pfcontext| |pfexpr|) - (PROG () (RETURN (|pfTree| '|DWhere| (LIST |pfcontext| |pfexpr|))))) - -;pfDWhere?(pf) == pfAbSynOp? (pf, 'DWhere) - -(DEFUN |pfDWhere?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|DWhere|)))) - -;pfDWhereContext pf == CADR pf -- was ==> - -(DEFUN |pfDWhereContext| (|pf|) (PROG NIL (RETURN (CADR |pf|)))) - -;pfDWhereExpr pf == CADDR pf -- was ==> - -(DEFUN |pfDWhereExpr| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - ;-- With := (Base: [Typed], Within: [WithPart]) ;pfWith(pfbase, pfwithin,pfwithon) == @@ -532,57 +295,6 @@ (PROG () (RETURN (|pfTree| '|With| (LIST |pfbase| |pfwithin| |pfwithon|))))) -;pfWith?(pf) == pfAbSynOp? (pf, 'With) - -(DEFUN |pfWith?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|With|)))) - -;pfWithBase pf == CADR pf -- was ==> - -(DEFUN |pfWithBase| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pfWithWithin pf == CADDR pf -- was ==> - -(DEFUN |pfWithWithin| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - -;pfWithWithon pf == CADDDR pf -- was ==> - -(DEFUN |pfWithWithon| (|pf|) (PROG () (RETURN (CADDDR |pf|)))) - -;pf0WithBase pf == pfParts pfWithBase pf - -(DEFUN |pf0WithBase| (|pf|) - (PROG () (RETURN (|pfParts| (|pfWithBase| |pf|))))) - -;pf0WithWithin pf == pfParts pfWithWithin pf - -(DEFUN |pf0WithWithin| (|pf|) - (PROG () (RETURN (|pfParts| (|pfWithWithin| |pf|))))) - -;-- WIf := (Cond: Primary, Then: [WithPart], Else: [WithPart]) - -;pfWIf(pfcond, pfthen, pfelse) == pfTree('WIf, [pfcond, pfthen, pfelse]) - -(DEFUN |pfWIf| (|pfcond| |pfthen| |pfelse|) - (PROG () - (RETURN (|pfTree| '|WIf| (LIST |pfcond| |pfthen| |pfelse|))))) - -;pfWIf?(pf) == pfAbSynOp? (pf, 'WIf) - -(DEFUN |pfWIf?| (|pf|) (PROG () (RETURN (|pfAbSynOp?| |pf| '|WIf|)))) - -;pfWIfCond pf == CADR pf -- was ==> - -(DEFUN |pfWIfCond| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pfWIfThen pf == CADDR pf -- was ==> - -(DEFUN |pfWIfThen| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - -;pfWIfElse pf == CADDDR pf -- was ==> - -(DEFUN |pfWIfElse| (|pf|) (PROG () (RETURN (CADDDR |pf|)))) - ;-- WDeclare := (Signature: Typed, Doc: ? Document) ;pfWDeclare(pfsignature, pfdoc) == pfTree('WDeclare, [pfsignature, pfdoc]) @@ -591,19 +303,6 @@ (PROG () (RETURN (|pfTree| '|WDeclare| (LIST |pfsignature| |pfdoc|))))) -;pfWDeclare?(pf) == pfAbSynOp? (pf, 'WDeclare) - -(DEFUN |pfWDeclare?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|WDeclare|)))) - -;pfWDeclareSignature pf == CADR pf -- was ==> - -(DEFUN |pfWDeclareSignature| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pfWDeclareDoc pf == CADDR pf -- was ==> - -(DEFUN |pfWDeclareDoc| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - ;-- Attribute := (Expr: Primary) ;pfAttribute(pfexpr) == pfTree('Attribute, [pfexpr]) @@ -611,15 +310,6 @@ (DEFUN |pfAttribute| (|pfexpr|) (PROG () (RETURN (|pfTree| '|Attribute| (LIST |pfexpr|))))) -;pfAttribute?(pf) == pfAbSynOp? (pf, 'Attribute) - -(DEFUN |pfAttribute?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|Attribute|)))) - -;pfAttributeExpr pf == CADR pf -- was ==> - -(DEFUN |pfAttributeExpr| (|pf|) (PROG () (RETURN (CADR |pf|)))) - ;-- Typed := (Id: Id, Type: ? Type) ;pfTyped(pfid, pftype) == pfTree('Typed, [pfid, pftype]) @@ -665,19 +355,6 @@ (DEFUN |pfRetractTo| (|pfexpr| |pftype|) (PROG () (RETURN (|pfTree| '|RetractTo| (LIST |pfexpr| |pftype|))))) -;pfRetractTo?(pf) == pfAbSynOp? (pf, 'RetractTo) - -(DEFUN |pfRetractTo?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|RetractTo|)))) - -;pfRetractToExpr pf == CADR pf -- was ==> - -(DEFUN |pfRetractToExpr| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pfRetractToType pf == CADDR pf -- was ==> - -(DEFUN |pfRetractToType| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - ;-- Coerceto := (Expr: Expr, Type: Type) ;pfCoerceto(pfexpr, pftype) == pfTree('Coerceto, [pfexpr, pftype]) @@ -692,53 +369,11 @@ (DEFUN |pfFromdom| (|pfwhat| |pfdomain|) (PROG () (RETURN (|pfTree| '|Fromdom| (LIST |pfwhat| |pfdomain|))))) -;-- Lambda := (Args: [Typed], Rets: ? Type, Body: Expr) - -;pfLambda(pfargs, pfrets, pfbody) == pfTree('Lambda, [pfargs, pfrets, pfbody]) - -(DEFUN |pfLambda| (|pfargs| |pfrets| |pfbody|) - (PROG () - (RETURN (|pfTree| '|Lambda| (LIST |pfargs| |pfrets| |pfbody|))))) - -;pfLambdaArgs pf == CADR pf -- was ==> - -(DEFUN |pfLambdaArgs| (|pf|) (PROG () (RETURN (CADR |pf|)))) - ;pfFix pf== pfApplication(pfId "Y",pf) (DEFUN |pfFix| (|pf|) (PROG () (RETURN (|pfApplication| (|pfId| 'Y) |pf|)))) -;-- TLambda := (Args: [Typed], Rets: ? Type, Body: Expr) - -;pfTLambda(pfargs, pfrets, pfbody)= pfTree('TLambda, [pfargs, pfrets, pfbody]) - -(DEFUN |pfTLambda| (|pfargs| |pfrets| |pfbody|) - (PROG () - (RETURN (|pfTree| '|TLambda| (LIST |pfargs| |pfrets| |pfbody|))))) - -;pfTLambda?(pf) == pfAbSynOp? (pf, 'TLambda) - -(DEFUN |pfTLambda?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|TLambda|)))) - -;pfTLambdaArgs pf == CADR pf -- was ==> - -(DEFUN |pfTLambdaArgs| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pfTLambdaRets pf == CADDR pf -- was ==> - -(DEFUN |pfTLambdaRets| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - -;pfTLambdaBody pf == CADDDR pf -- was ==> - -(DEFUN |pfTLambdaBody| (|pf|) (PROG () (RETURN (CADDDR |pf|)))) - -;pf0TLambdaArgs pf == pfParts pfTLambdaArgs pf - -(DEFUN |pf0TLambdaArgs| (|pf|) - (PROG () (RETURN (|pfParts| (|pfTLambdaArgs| |pf|))))) - ;-- MLambda := (Args: [Id], Body: Expr) ;pfMLambda(pfargs, pfbody) == pfTree('MLambda, [pfargs, pfbody]) @@ -774,19 +409,6 @@ (PROG () (RETURN (|pfTree| '|If| (LIST |pfcond| |pfthen| |pfelse|))))) -;-- Sequence := (Args: [Expr]) - -;pfSequenceArgs pf == CADR pf -- was ==> - -(DEFUN |pfSequenceArgs| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pf0SequenceArgs pf == pfParts pfSequenceArgs pf - -(DEFUN |pf0SequenceArgs| (|pf|) - (PROG () (RETURN (|pfParts| (|pfSequenceArgs| |pf|))))) - -;-- Novalue := (Expr: Expr) - ;-- Loop := (Iterators: [Iterator]) ;pfLoop(pfiterators) == pfTree('Loop, [pfiterators]) @@ -802,11 +424,6 @@ (PROG () (RETURN (|pfTree| '|Collect| (LIST |pfbody| |pfiterators|))))) -;pf0CollectIterators pf == pfParts pfCollectIterators pf - -(DEFUN |pf0CollectIterators| (|pf|) - (PROG () (RETURN (|pfParts| (|pfCollectIterators| |pf|))))) - ;-- Forin := (Lhs: [AssLhs], Whole: Expr) ;pfForin(pflhs, pfwhole) == pfTree('Forin, [pflhs, pfwhole]) @@ -849,10 +466,6 @@ (DEFUN |pfIterate| (|pffrom|) (PROG () (RETURN (|pfTree| '|Iterate| (LIST |pffrom|))))) -;pfIterateFrom pf == CADR pf -- was ==> - -(DEFUN |pfIterateFrom| (|pf|) (PROG () (RETURN (CADR |pf|)))) - ;-- Break := (From: ? Id) ;pfBreak(pffrom) == pfTree('Break, [pffrom]) @@ -867,10 +480,6 @@ (DEFUN |pfReturn| (|pfexpr| |pffrom|) (PROG () (RETURN (|pfTree| '|Return| (LIST |pfexpr| |pffrom|))))) -;pfReturnFrom pf == CADDR pf -- was ==> - -(DEFUN |pfReturnFrom| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - ;-- Exit := (Cond: ? Expr, Expr: ? Expr) ;pfExit(pfcond, pfexpr) == pfTree('Exit, [pfcond, pfexpr]) @@ -901,40 +510,6 @@ (PROG () (RETURN (|pfTree| '|Definition| (LIST |pflhsitems| |pfrhs|))))) -;-- ComDefinition := (Doc:Document,Def:Definition) - -;pfComDefinition(pfdoc, pfdef) == pfTree('ComDefinition, [pfdoc, pfdef] ) - -(DEFUN |pfComDefinition| (|pfdoc| |pfdef|) - (PROG () - (RETURN (|pfTree| '|ComDefinition| (LIST |pfdoc| |pfdef|))))) - -;pfComDefinition?(pf) == pfAbSynOp? (pf, 'ComDefinition) - -(DEFUN |pfComDefinition?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|ComDefinition|)))) - -;pfComDefinitionDoc pf == CADR pf -- was ==> - -(DEFUN |pfComDefinitionDoc| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pfComDefinitionDef pf == CADDR pf -- was ==> - -(DEFUN |pfComDefinitionDef| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - -;-- DefinitionSequence := (Args: [DeclPart]) -; -;pfDefinitionSequenceArgs pf == CADR pf -- was ==> - -(DEFUN |pfDefinitionSequenceArgs| (|pf|) - (PROG () (RETURN (CADR |pf|)))) - -;-- Export := (Def: Definition) - -;pfExportDef pf == CADR pf -- was ==> - -(DEFUN |pfExportDef| (|pf|) (PROG () (RETURN (CADR |pf|)))) - ;-- Assign := (LhsItems: [AssLhs], Rhs: Expr) ; ;pfAssign(pflhsitems, pfrhs) == pfTree('Assign, [pflhsitems, pfrhs]) @@ -949,20 +524,6 @@ (DEFUN |pfTyping| (|pfitems|) (PROG () (RETURN (|pfTree| '|Typing| (LIST |pfitems|))))) -;pfTyping?(pf) == pfAbSynOp? (pf, 'Typing) - -(DEFUN |pfTyping?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|Typing|)))) - -;pfTypingItems pf == CADR pf -- was ==> - -(DEFUN |pfTypingItems| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pf0TypingItems pf == pfParts pfTypingItems pf - -(DEFUN |pf0TypingItems| (|pf|) - (PROG () (RETURN (|pfParts| (|pfTypingItems| |pf|))))) - ;-- Export := (Items: [Typed]) ;pfExport(pfitems) == pfTree('Export, [pfitems]) @@ -970,20 +531,6 @@ (DEFUN |pfExport| (|pfitems|) (PROG () (RETURN (|pfTree| '|Export| (LIST |pfitems|))))) -;pfExport?(pf) == pfAbSynOp? (pf, 'Export) - -(DEFUN |pfExport?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|Export|)))) - -;pfExportItems pf == CADR pf -- was ==> - -(DEFUN |pfExportItems| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pf0ExportItems pf == pfParts pfExportItems pf - -(DEFUN |pf0ExportItems| (|pf|) - (PROG () (RETURN (|pfParts| (|pfExportItems| |pf|))))) - ;-- Local := (Items: [Typed]) ;pfLocal(pfitems) == pfTree('Local, [pfitems]) @@ -1005,20 +552,6 @@ (DEFUN |pfImport| (|pfitems|) (PROG () (RETURN (|pfTree| '|Import| (LIST |pfitems|))))) -;pfImport?(pf) == pfAbSynOp? (pf, 'Import) - -(DEFUN |pfImport?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|Import|)))) - -;pfImportItems pf == CADR pf -- was ==> - -(DEFUN |pfImportItems| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pf0ImportItems pf == pfParts pfImportItems pf - -(DEFUN |pf0ImportItems| (|pf|) - (PROG () (RETURN (|pfParts| (|pfImportItems| |pf|))))) - ;-- Inline := (Items: [QualType]) ;pfInline(pfitems) == pfTree('Inline, [pfitems]) @@ -1026,15 +559,6 @@ (DEFUN |pfInline| (|pfitems|) (PROG () (RETURN (|pfTree| '|Inline| (LIST |pfitems|))))) -;pfInline?(pf) == pfAbSynOp? (pf, 'Inline) - -(DEFUN |pfInline?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|Inline|)))) - -;pfInlineItems pf == CADR pf -- was ==> - -(DEFUN |pfInlineItems| (|pf|) (PROG () (RETURN (CADR |pf|)))) - ;-- QualType := (Type: Type, Qual: ? Type) ;pfQualType(pftype, pfqual) == pfTree('QualType, [pftype, pfqual]) @@ -1042,19 +566,6 @@ (DEFUN |pfQualType| (|pftype| |pfqual|) (PROG () (RETURN (|pfTree| '|QualType| (LIST |pftype| |pfqual|))))) -;pfQualType?(pf) == pfAbSynOp? (pf, 'QualType) - -(DEFUN |pfQualType?| (|pf|) - (PROG () (RETURN (|pfAbSynOp?| |pf| '|QualType|)))) - -;pfQualTypeType pf == CADR pf -- was ==> - -(DEFUN |pfQualTypeType| (|pf|) (PROG () (RETURN (CADR |pf|)))) - -;pfQualTypeQual pf == CADDR pf -- was ==> - -(DEFUN |pfQualTypeQual| (|pf|) (PROG () (RETURN (CADDR |pf|)))) - ;pfSuch(x,y)== pfInfApplication(pfId "|",x,y) (DEFUN |pfSuch| (|x| |y|) diff --git a/src/interp/serror.lisp.pamphlet b/src/interp/serror.lisp.pamphlet index 8fc6ea2..0c61000 100644 --- a/src/interp/serror.lisp.pamphlet +++ b/src/interp/serror.lisp.pamphlet @@ -72,19 +72,6 @@ ; ncSoftError(tokPosn $stok,'S2CY0007, [PNAME s]) ; THROW("TRAPPOINT","TRAPPED") -(DEFUN |npMissing| (|s|) - (PROG () - (DECLARE (SPECIAL |$stok|)) - (RETURN - (PROGN - (|ncSoftError| (|tokPosn| |$stok|) 'S2CY0007 - (LIST (PNAME |s|))) - (THROW 'TRAPPOINT 'TRAPPED))))) - -;npCompMissing s == npEqKey s or npMissing s - -(DEFUN |npCompMissing| (|s|) - (PROG () (RETURN (OR (|npEqKey| |s|) (|npMissing| |s|))))) ;pfSourceStok x== ; if pfLeaf? x @@ -122,18 +109,6 @@ (|ncSoftError| (|tokPosn| |a|) 'S2CY0002 NIL) (THROW 'TRAPPOINT 'TRAPPED)))))))) -;npTrap()== -; ncSoftError(tokPosn $stok,'S2CY0002,[]) -; THROW("TRAPPOINT","TRAPPED") - -(DEFUN |npTrap| () - (PROG () - (DECLARE (SPECIAL |$stok|)) - (RETURN - (PROGN - (|ncSoftError| (|tokPosn| |$stok|) 'S2CY0002 NIL) - (THROW 'TRAPPOINT 'TRAPPED))))) - ;npRecoverTrap()== ; npFirstTok() ; pos1 := tokPosn $stok diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index f623d02..2b1f138 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -2381,21 +2381,6 @@ do the compile, and then rename the result back to code.o. (defun |ListMember?| (ob l) (member ob l :test #'equal) ) -; rewrite nnPP for csl, which does not support flet -(defvar *npPParg* nil "rewrite flets, using global scoping") -(defun npPPff () (and (funcall *npPParg*) (|npPush| (list (|npPop1|))))) -(defun npPPf () (|npSemiListing| (function npPPff))) -(defun npPPg () - (and (|npListAndRecover| (function npPPf))) - (|npPush| (|pfAppend| (|npPop1|)))) -(defun |npPP| (|f|) - (declare (special *npPParg*)) - (setq *npPParg* |f|) - (or (|npParened| (function npPPf)) - (and (|npPileBracketed| (function npPPg)) - (|npPush| (|pfEnSequence| (|npPop1|)))) - (funcall |f|))) - (defvar *npPCff* nil "rewrite flets, using global scoping") (defun npPCff () (and (funcall *npPCff*) (|npPush| (list (|npPop1|))))) (defun npPCg ()