diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index abe6aa7..b74e87f 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -115,16 +115,6 @@ \index{\${#1}!defconstant}} %% -%% defstruct marks a struct definition and adds it to the index -%% -\newcommand{\defstruct}[1]{% e.g. \defstruct{structname} -\subsection{defstruct \${#1}}% -\label{#1}% -\index{#1}% -\index{defstruct!#1}% -\index{#1!defstruct}} - -%% %% pagehead consolidates standard page indexing %% \newcommand{\pagehead}[2]{% e.g. \pagehead{name}{abb} @@ -1909,8 +1899,7 @@ coerceInteractive, so it only does the JENKS cases ALBI @ -\defun{recordAndPrint}{} -Result Output Printing. +\defun{recordAndPrint}{Result Output Printing} Prints out the value x which is of type m, and records the changes in environment \verb|$e| into \verb|$InteractiveFrame| \verb|$printAnyIfTrue| is documented in setvart.boot. @@ -4608,6 +4597,13 @@ To pair badge and badgee @ +\defmacro{memq} +<>= +(defmacro memq (a b) + `(member ,a ,b :test #'eq)) + +@ + \defvar{scanCloser} <>= (eval-when (eval load) @@ -5838,7 +5834,6 @@ p o p o = (p o p) o \calls{npDDInfKey}{npInfKey} \calls{npDDInfKey}{npState} \calls{npDDInfKey}{npEqKey} -\calls{npDDInfKey}{npInfKey} \calls{npDDInfKey}{npPush} \calls{npDDInfKey}{pfSymb} \calls{npDDInfKey}{npPop1} @@ -5871,6 +5866,37 @@ p o p o = (p o p) o @ +\defun{npInfKey}{npInfKey} +\calls{npInfKey}{memq} +\calls{npInfKey}{npPushId} +\usesdollar{npInfKey}{stok} +\usesdollar{npInfKey}{ttok} +<>= +(defun |npInfKey| (s) + (declare (special |$ttok| |$stok|)) + (and (eq (caar |$stok|) '|key|) (memq |$ttok| s) (|npPushId|))) + +@ + +\defun{npPushId}{npPushId} +\calls{npPushId}{tokConstruct} +\calls{npPushId}{tokPosn} +\calls{npPushId}{npNext} +\usesdollar{npPushId}{stack} +\usesdollar{npPushId}{stok} +\usesdollar{npPushId}{ttok} +<>= +(defun |npPushId| () + (let (a) + (declare (special |$stack| |$stok| |$ttok|)) + (setq a (get |$ttok| 'infgeneric)) + (when a (setq |$ttok| a)) + (setq |$stack| + (cons (|tokConstruct| '|id| |$ttok| (|tokPosn| |$stok|)) |$stack|)) + (|npNext|))) + +@ + \defvar{npPParg} <>= (defvar *npPParg* nil "rewrite npPP without flets, using global scoping") @@ -6006,6 +6032,118 @@ This was rewritten by NAG to remove flet. @ \chapter{Pftrees} +\section{Abstract Syntax Trees Overview} + +Th functions create and examine abstract syntax trees. +These are called pforms, for short. + +The pform data structure + +\begin{itemize} +\item Leaves: [hd, tok, pos] where pos is optional +\item Trees: [hd, tree, tree, ...] +\item hd is either an id or (id . alist) +\end{itemize} + +The leaves are: + +\begin{tabular}{lcl} + char &:=& ('char expr position) \\ + Document &:=& ('Document expr position) \\ + error &:=& ('error expr position) \\ + expression &:=& ('expression expr position) \\ + float &:=& ('float expr position) \\ + id &:=& ('id expr position)\\ + idsy &:=& ('idsy expr position)\\ + integer &:=& ('integer expr position)\\ + string &:=& ('string expr position)\\ + symbol &:=& ('symbol expr position) +\end{tabular} + +The special nodes: + +\begin{tabular}{lcl} + ListOf &:=& ('listOf items)\\ + Nothing &:=& ('nothing)\\ + SemiColon &:=& ('SemiColon (Body: Expr)) +\end{tabular} + +The expression nodes: + +\begin{tabular}{lcl} + Add &:=& ('Add (Base: [Typed], Addin: Expr))\\ + And &:=& ('And left right)\\ + Application &:=& ('Application (Op: Expr, Arg: Expr))\\ + Assign &:=& ('Assign (LhsItems: [AssLhs], Rhs: Expr))\\ + Attribute &:=& ('Attribute (Expr: Primary))\\ + Break &:=& ('Break (From: ? Id))\\ + Coerceto &:=& ('Coerceto (Expr: Expr, Type: Type))\\ + Collect &:=& ('Collect (Body: Expr, Iterators: [Iterator]))\\ + ComDefinition &:=& ('ComDefinition (Doc: Document, Def: Definition))\\ + DeclPart &&\\ + Definition &:=& ('Definition (LhsItems: [Typed], Rhs: Expr))\\ + DefinitionSequence &:=& (Args: [DeclPart])\\ + Do &:=& ('Do (Body: Expr))\\ + Document &:=& ('Document strings)\\ + DWhere &:=& ('DWhere (Context: [DeclPart], Expr: [DeclPart]))\\ + EnSequence &:=&\\ + Exit &:=& ('Exit (Cond: ? Expr, Expr: ? Expr))\\ + Export &:=& ('Export (Items: [Typed]))\\ + Forin &:=& ('Forin (Lhs: [AssLhs], Whole: Expr))\\ + Free &:=& ('Free (Items: [Typed]))\\ + Fromdom &:=& ('Fromdom (What: Id, Domain: Type))\\ + Hide &:=& ('hide, arg)\\ + If &:=& ('If (Cond: Expr, Then: Expr, Else: ? Expr))\\ + Import &:=& ('Import (Items: [QualType]))\\ + Inline &:=& ('Inline (Items: [QualType]))\\ + Iterate &:=& ('Iterate (From: ? Id))\\ + Lambda &:=& ('Lambda (Args: [Typed], Rets: ReturnedTyped, Body: Expr))\\ + Literal \\ + Local &:=& ('Local (Items: [Typed]))\\ + Loop &:=& ('Loop (Iterators: [Iterator]))\\ + Macro &:=& ('Macro (Lhs: Id, Rhs: ExprorNot))\\ + MLambda &:=& ('MLambda (Args: [Id], Body: Expr))\\ + Not &:=& ('Not arg)\\ + Novalue &:=& ('Novalue (Expr: Expr))\\ + Or &:=& ('Or left right)\\ + Pretend &:=& ('Pretend (Expr: Expr, Type: Type))\\ + QualType &:=& ('QualType (Type: Type, Qual: ? Type))\\ + Restrict &:=& ('Restrict (Expr: Expr, Type: Type))\\ + Retract &:=& ('RetractTo (Expr: Expr, Type: Type))\\ + Return &:=& ('Return (Expr: ? Expr, From: ? Id))\\ + ReturnTyped &:=& ('returntyuped (type body))\\ + Rule &:=& ('Rule (lhsitems, rhsitems))\\ + Sequence &:=& ('Sequence (Args: [Expr]))\\ + Suchthat &:=& ('Suchthat (Cond: Expr))\\ + Symb &:=& if leaf then symbol else expression\\ + Tagged &:=& ('Tagged (Tag: Expr, Expr: Expr))\\ + TLambda &:=&('TLambda (Args: [Typed], \\ + &&\quad{}Rets: ReturnedTyped Type, Body: Expr))\\ + Tuple &:=& ('Tuple (Parts: [Expr]))\\ + Typed &:=& ('Typed (Id: Id, Type: ? Type))\\ + Typing &:=& ('Typing (Items: [Typed]))\\ + Until &:=& ('Until (Cond: Expr)) NOT USED\\ + WDeclare &:=& ('WDeclare (Signature: Typed, Doc: ? Document))\\ + Where &:=& ('Where (Context: [DeclPart], Expr: Expr))\\ + While &:=& ('While (Cond: Expr))\\ + With &:=& ('With (Base: [Typed], Within: [WithPart]))\\ + WIf &:=& ('WIf (Cond: Primary, Then: [WithPart], Else: [WithPart]))\\ + Wrong &:=& ('Wrong (Why: Document, Rubble: [Expr])) +\end{tabular} + +Special cases of expression nodes are: + +\begin{itemize} +\item Application. The Op parameter is one of + \verb/and, or, Y, |, {}, [], {||}, [||]/ +\item DeclPart. The comment is attached to all signatutres in + Typing, Import, Definition, Sequence, DWhere, Macro nodes +\item EnSequence. This is either a Tuple or Sequence depending on the +argument +\item Literal. One of integer symbol expression one zero char string float +of the form ('expression expr position) +\end{itemize} + \section{Special Nodes} \defun{pfListOf}{Create a Listof node} @@ -6084,6 +6222,17 @@ This was rewritten by NAG to remove flet. @ +\defun{pfLeaf?}{Is this a leaf node?} +\calls{pfLeaf?}{memq} +\calls{pfLeaf?}{pfAbSynOp} +<>= +(defun |pfLeaf?| (form) + (memq (|pfAbSynOp| form) + '(|id| |idsy| |symbol| |string| |char| |float| |expression| + |integer| |Document| |error|))) + +@ + \defun{pfLeafToken}{Return the Leaf Token} \calls{pfLeafToken}{tokPart} <>= @@ -6124,6 +6273,65 @@ This was rewritten by NAG to remove flet. @ +\defun{pfSexpr}{An S-expression which people can read.} +\calls{pfSexpr}{pfSexpr,strip} +<>= +(defun |pfSexpr| (pform) + (|pfSexpr,strip| pform)) + +@ + +\defun{pfSexpr,strip}{Create a human readable S-expression} +\calls{pfSexpr,strip}{pfId?} +\calls{pfSexpr,strip}{pfIdSymbol} +\calls{pfSexpr,strip}{pfLiteral?} +\calls{pfSexpr,strip}{pfLiteralString} +\calls{pfSexpr,strip}{pfLeaf?} +\calls{pfSexpr,strip}{tokPart} +\calls{pfSexpr,strip}{pfApplication?} +\calls{pfSexpr,strip}{pfApplicationArg} +\calls{pfSexpr,strip}{pfTuple?} +\calls{pfSexpr,strip}{pf0TupleParts} +\calls{pfSexpr,strip}{pfApplicationOp} +\calls{pfSexpr,strip}{pfSexpr,strip} +\calls{pfSexpr,strip}{pfAbSynOp} +\calls{pfSexpr,strip}{pfParts} +<>= +(defun |pfSexpr,strip| (pform) + (let (args a result) + (cond + ((|pfId?| pform) (|pfIdSymbol| pform)) + ((|pfLiteral?| pform) (|pfLiteralString| pform)) + ((|pfLeaf?| pform) (|tokPart| pform)) + ((|pfApplication?| pform) + (setq a (|pfApplicationArg| pform)) + (if (|pfTuple?| a) + (setq args (|pf0TupleParts| a)) + (setq args (list a))) + (dolist (p (cons (|pfApplicationOp| pform) args) (nreverse result)) + (push (|pfSexpr,strip| |p|) result))) + (t + (cons (|pfAbSynOp| pform) + (dolist (p (|pfParts| pform) (nreverse result)) + (push (|pfSexpr,strip| |p|) result))))))) + +@ + +\defun{pfSymb}{Construct a Symbol or Expression node} +\calls{pfSymb}{pfLeaf?} +\calls{pfSymb}{pfSymbol} +\calls{pfSymb}{tokPart} +\calls{pfSymb}{ifcar} +\calls{pfSymb}{pfExpression} +\calls{pfSymb}{pfSexpr} +<>= +(defun |pfSymb| (expr &REST optpos) + (if (|pfLeaf?| expr) + (|pfSymbol| (|tokPart| expr) (ifcar optpos)) + (|pfExpression| (|pfSexpr| expr) (ifcar optpos)))) + +@ + \defun{pfSymbol?}{Is this a Symbol node?} \calls{pfSymbol?}{pfAbSynOp?} <>= @@ -6157,6 +6365,14 @@ This was rewritten by NAG to remove flet. @ +\defun{pfAttribute}{pfAttribute} +\calls{pfAttribute}{pfTree} +<>= +(defun |pfAttribute| (pfexpr) + (|pfTree| '|Attribute| (list pfexpr))) + +@ + \defun{pfApplication}{Return an Application node} \calls{pfApplication}{pfTree} <>= @@ -6471,6 +6687,14 @@ This was rewritten by NAG to remove flet. @ +\defun{pfIf}{pfIf} +\calls{pfIf}{pfTree} +<>= +(defun |pfIf| (pfcond pfthen pfelse) + (|pfTree| '|If| (list pfcond pfthen pfelse))) + +@ + \defun{pfIf?}{Is this an If node?} \calls{pfIf?}{pfAbSynOp?} <>= @@ -6493,6 +6717,15 @@ This was rewritten by NAG to remove flet. @ +\defun{pfIfThenOnly}{pfIfThenOnly} +\calls{pfIfThenOnly}{pfIf} +\calls{pfIfThenOnly}{pfNothing} +<>= +(defun |pfIfThenOnly| (pred cararg) + (|pfIf| pred cararg (|pfNothing|))) + +@ + \defun{pfIfElse}{Return the Else part of an If} <>= (defun |pfIfElse| (pf) @@ -6653,7 +6886,7 @@ This was rewritten by NAG to remove flet. @ \defun{pfNovalue}{Construct a NoValue node} -\calls{pfNovalue}{} +\calls{pfNovalue}{pfTree} <>= (defun |pfNovalue| (pfexpr) (|pfTree| '|Novalue| (list pfexpr))) @@ -6878,6 +7111,22 @@ This was rewritten by NAG to remove flet. @ +\defun{pfTweakIf}{pfTweakIf} +\calls{pfTweakIf}{pfIfElse} +\calls{pfTweakIf}{pfNothing?} +\calls{pfTweakIf}{pfListOf} +\calls{pfTweakIf}{pfTree} +\calls{pfTweakIf}{pfIfCond} +\calls{pfTweakIf}{pfIfThen} +<>= +(defun |pfTweakIf| (form) + (let (b a) + (setq a (|pfIfElse| form)) + (setq b (if (|pfNothing?| a) (|pfListOf| NIL) a)) + (|pfTree| '|WIf| (list (|pfIfCond| form) (|pfIfThen| form) b)))) + +@ + \defun{pfTyped?}{Is this a Typed node?} \calls{pfTyped?}{pfAbSynOp?} <>= @@ -6993,7 +7242,7 @@ This was rewritten by NAG to remove flet. @ -\defun{pfWhileCond}{} +\defun{pfWhileCond}{Return the Cond part of a While node} <>= (defun |pfWhileCond| (pf) (cadr pf)) @@ -11789,10 +12038,13 @@ new system commands provided you handle the argument parsing. @ -\defun{systemCommand}{} +\defun{systemCommand}{Handle system commands} You can type ``)?'' and see trivial help information. You can type ``)? compiler'' and see compiler related information -\calls{systemCommand}{} +\calls{systemCommand}{selectOptionLC} +\calls{systemCommand}{helpSpad2Cmd} +\calls{systemCommand}{selectOption} +\calls{systemCommand}{commandsForUserLevel} \usesdollar{systemCommand}{options} \usesdollar{systemCommand}{e} \usesdollar{systemCommand}{systemCommands} @@ -11872,7 +12124,6 @@ valid for this level. \defun{optionUserLevelError}{Option not available at this user level} \calls{optionUserLevelError}{userLevelErrorMessage} -\usesdollar{}{} <>= (defun |optionUserLevelError| (x u) (|userLevelErrorMessage| '|option| x u)) @@ -12231,7 +12482,7 @@ The \verb|$msgdbPrims| variable is set to: @ -\defun{displayValue}{} +\defun{displayValue}{displayValue} \calls{displayValue}{sayMSG} \calls{displayValue}{fixObjectForPrinting} \calls{displayValue}{pname} @@ -12775,7 +13026,6 @@ Note that unAbbreviateKeyword returns the word ``system'' for unknown words so we have to search for this case. This complication may never arrive in practice. \calls{npsystem}{sayKeyedMsg} -\usesdollar{}{} <>= (defun |npsystem| (unab str) (let (spaceIndex sysPart) @@ -16437,10 +16687,10 @@ Available algebra help topics are: \calls{helpSpad2Cmd}{newHelpSpad2Cmd} \calls{helpSpad2Cmd}{sayKeyedMsg} <>= -(defun |helpSpad2Cmd| (|args|) +(defun |helpSpad2Cmd| (args) "The top level help command handler" - (unless (|newHelpSpad2Cmd| |args|) - (|sayKeyedMsg| 's2iz0025 (cons |args| nil)))) + (unless (|newHelpSpad2Cmd| args) + (|sayKeyedMsg| 's2iz0025 (cons args nil)))) @ @@ -18831,13 +19081,13 @@ o )history \fnref{history}} \defun{read}{The )read command} -\calls{}{readSpad2Cmd} +\calls{read}{readSpad2Cmd} <>= (defun |read| (arg) (|readSpad2Cmd| arg)) @ -\defun{readSpad2Cmd}{} +\defun{readSpad2Cmd}{Implement the )read command} \calls{readSpad2Cmd}{selectOptionLC} \calls{readSpad2Cmd}{optionError} \calls{readSpad2Cmd}{pathname} @@ -26214,7 +26464,7 @@ o )what \fnref{what}} \defun{synonym}{The )synonym command} -\calls{synonym}{} +\calls{synonym}{synonymSpad2Cmd} <>= (defun |synonym| (&rest ignore) (declare (ignore ignore)) @@ -26283,7 +26533,7 @@ synonyms at the current user level. @ -\defun{processSynonymLine,removeKeyFromLine}{} +\defun{processSynonymLine,removeKeyFromLine}{Remove system keyword} \calls{processSynonymLine,removeKeyFromLine}{dropLeadingBlanks} \calls{processSynonymLine,removeKeyFromLine}{maxindex} \calls{processSynonymLine,removeKeyFromLine}{qsadd1} @@ -28281,7 +28531,7 @@ This reports the traced functions |val|)))) @ -\defun{isSharpVarWithNum}{Identifier beginning with \verb|#number|?} +\defun{isSharpVarWithNum}{Identifier beginning with a sharpsign-number?} This tests if x is an identifier beginning with \verb|#| followed by a number. \calls{isSharpVarWithNum}{isSharpVar} \calls{isSharpVarWithNum}{pname} @@ -28306,7 +28556,7 @@ This tests if x is an identifier beginning with \verb|#| followed by a number. @ -\defun{isSharpVar}{Identifier beginning with \verb|#|?} +\defun{isSharpVar}{Identifier beginning with a sharpsign?} This tests if x is an identifier beginning with \verb|#| \calls{isSharpVar}{identp} <>= @@ -30550,7 +30800,7 @@ o )library @ \chapter{Handling input files} -\defun{readSpadProfileIfThere}{} +\defun{readSpadProfileIfThere}{Handle .axiom.input file} \uses{readSpadProfileIfThere}{/editfile} <>= (defun |readSpadProfileIfThere| () @@ -30560,7 +30810,7 @@ o )library @ -\defun{/rq}{} +\defun{/rq}{/rq} \calls{/rq}{/rf-1} \uses{/rq}{Echo-Meta} <>= @@ -30617,7 +30867,7 @@ o )library @ \defun{spad}{spad} -\catches{spad-reader} +\catches{spad}{spad-reader} \calls{spad}{addBinding} \calls{spad}{makeInitialModemapFrame} \calls{spad}{init-boot/spad-reader} @@ -32040,7 +32290,6 @@ Format of an entry in browse.daase: \defun{setdatabase}{Set a value for a constructor key in the database} \calls{setdatabase}{make-database} -\usesdollar{}{} <>= (defun setdatabase (constructor key value) (let (struct) @@ -33199,7 +33448,6 @@ database format. \subsection{Database support operations} \defun{write-warmdata}{Data preloaded into the image at build time} -\calls{write-warmdata}{} \usesdollar{write-warmdata}{topicHash} <>= (defun write-warmdata () @@ -34818,7 +35066,7 @@ for example: @ -\defun{}{Write out a list of symbols or structures to a file} +\defun{monitor-write}{Write out a list of symbols or structures to a file} <>= (defun monitor-write (items file) "write out a list of symbols or structures to a file" @@ -35744,6 +35992,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -35764,6 +36013,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -35816,6 +36066,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -35852,6 +36103,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -35863,6 +36115,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -35913,9 +36166,12 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> +<> <> <> <> +<> <> <> <> @@ -35924,6 +36180,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> diff --git a/changelog b/changelog index 287182d..5e30657 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,9 @@ +20100215 tpd src/axiom-website/patches.html 20100215.01.tpd.patch +20100215 tpd src/interp/vmlisp.lisp treeshake +20100215 tpd src/interp/ptrop.lisp treeshake +20100215 tpd src/interp/ptrees.lisp treeshake +20100215 tpd src/interp/cparse.lisp treeshake +20100215 tpd books/bookvol5 treeshake cparse, ptrees, ptrop vmlisp 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 diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 942c96c..cd24bb5 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2457,5 +2457,7 @@ books/bookvol5 treeshake ptrees.lisp
books/bookvol5 treeshake cparse, ptrees, serror, vmlisp
20100214.02.tpd.patch books/bookvol5 treeshake cparse, ptrees
+20100215.01.tpd.patch +books/bookvol5 treeshake cparse, ptrees, ptrop vmlisp
diff --git a/src/interp/cparse.lisp.pamphlet b/src/interp/cparse.lisp.pamphlet index 2be2ccc..d448dfc 100644 --- a/src/interp/cparse.lisp.pamphlet +++ b/src/interp/cparse.lisp.pamphlet @@ -22,16 +22,6 @@ ; $ttok:= if a then a else $ttok ; $stack:=CONS(tokConstruct("id",$ttok,tokPosn $stok),$stack) ; npNext() -(DEFUN |npPushId| () - (PROG (|a|) - (DECLARE (SPECIAL |$stack| |$stok| |$ttok|)) - (RETURN - (PROGN - (SETQ |a| (GET |$ttok| (QUOTE INFGENERIC))) - (SETQ |$ttok| (COND (|a| |a|) ((QUOTE T) |$ttok|))) - (SETQ |$stack| - (CONS (|tokConstruct| (QUOTE |id|) |$ttok| (|tokPosn| |$stok|)) |$stack|)) - (|npNext|))))) ;npParenthesized f== ; npParenthesize("(",")",f) or @@ -298,13 +288,6 @@ (|tokConstruct| (QUOTE |idsy|) (|tokPart| |a|) (|tokPosn| |a|))))) (#0# (PROGN (|npRestore| |a|) NIL))))))))))) -;npInfKey s== EQ(CAAR $stok,"key") and MEMQ($ttok,s) and npPushId() -(DEFUN |npInfKey| (|s|) - (PROG NIL - (DECLARE (SPECIAL |$ttok| |$stok|)) - (RETURN - (AND (EQ (CAAR |$stok|) (QUOTE |key|)) (MEMQ |$ttok| |s|) (|npPushId|))))) - ;-- Parsing functions ;$npTokToNames:= ["~","#","[]","{}", "[||]","{||}"] diff --git a/src/interp/ptrees.lisp.pamphlet b/src/interp/ptrees.lisp.pamphlet index 5b81678..1258def 100644 --- a/src/interp/ptrees.lisp.pamphlet +++ b/src/interp/ptrees.lisp.pamphlet @@ -12,18 +12,6 @@ <<*>>= (in-package "BOOT") -;pfLeaf? form == -; MEMQ(pfAbSynOp form, -; '(id idsy symbol string char float expression integer -; Document error)) - -(DEFUN |pfLeaf?| (|form|) - (PROG () - (RETURN - (MEMQ (|pfAbSynOp| |form|) - '(|id| |idsy| |symbol| |string| |char| |float| |expression| - |integer| |Document| |error|))))) - ;pfLeafPosition form == tokPosn form (DEFUN |pfLeafPosition| (|form|) @@ -51,19 +39,6 @@ (DEFUN |pfSymbol| (|expr| &REST |optpos|) (PROG () (RETURN (|pfLeaf| '|symbol| |expr| (IFCAR |optpos|))))) -;pfSymb(expr, :optpos) == -; if pfLeaf? expr -; then pfSymbol(tokPart expr,IFCAR optpos) -; else pfExpression(pfSexpr expr,IFCAR optpos) - -(DEFUN |pfSymb| (|expr| &REST |optpos|) - (PROG () - (RETURN - (COND - ((|pfLeaf?| |expr|) - (|pfSymbol| (|tokPart| |expr|) (IFCAR |optpos|))) - ('T (|pfExpression| (|pfSexpr| |expr|) (IFCAR |optpos|))))))) - ;--% TREES ;-- parser interface functions ;-- these are potential sources of trouble in macro expansion @@ -86,21 +61,6 @@ (SETQ |bfVar#1| (CDR |bfVar#1|)))) NIL (|pfParts| |name|) NIL)))) -;pfTweakIf form== -; a:=pfIfElse form -; b:=if pfNothing? a then pfListOf [] else a -; pfTree('WIf,[pfIfCond form,pfIfThen form,b]) - -(DEFUN |pfTweakIf| (|form|) - (PROG (|b| |a|) - (RETURN - (PROGN - (SETQ |a| (|pfIfElse| |form|)) - (SETQ |b| - (COND ((|pfNothing?| |a|) (|pfListOf| NIL)) ('T |a|))) - (|pfTree| '|WIf| - (LIST (|pfIfCond| |form|) (|pfIfThen| |form|) |b|)))))) - ;pfFromDom(dom,expr)== ; if pfApplication? expr ; then pfApplication(pfFromdom(pfApplicationOp expr,dom), @@ -118,11 +78,6 @@ (|pfApplicationArg| |expr|))) ('T (|pfFromdom| |expr| |dom|)))))) -;pfIfThenOnly(pred,first)==pfIf(pred,first,pfNothing()) - -(DEFUN |pfIfThenOnly| (|pred| CAR) - (PROG () (RETURN (|pfIf| |pred| CAR (|pfNothing|))))) - ;pfLp(iterators,body)== ; pfLoop pfListOf [:iterators,pfDo body] @@ -274,13 +229,6 @@ (PROG () (RETURN (|pfTree| '|WDeclare| (LIST |pfsignature| |pfdoc|))))) -;-- Attribute := (Expr: Primary) - -;pfAttribute(pfexpr) == pfTree('Attribute, [pfexpr]) - -(DEFUN |pfAttribute| (|pfexpr|) - (PROG () (RETURN (|pfTree| '|Attribute| (LIST |pfexpr|))))) - ;-- Typed := (Id: Id, Type: ? Type) ;pfTyped(pfid, pftype) == pfTree('Typed, [pfid, pftype]) @@ -370,9 +318,6 @@ ; ;pfIf(pfcond, pfthen, pfelse) == pfTree('If, [pfcond, pfthen, pfelse]) -(DEFUN |pfIf| (|pfcond| |pfthen| |pfelse|) - (PROG () - (RETURN (|pfTree| '|If| (LIST |pfcond| |pfthen| |pfelse|))))) ;-- Loop := (Iterators: [Iterator]) diff --git a/src/interp/ptrop.lisp.pamphlet b/src/interp/ptrop.lisp.pamphlet index 0331708..0a283fa 100644 --- a/src/interp/ptrop.lisp.pamphlet +++ b/src/interp/ptrop.lisp.pamphlet @@ -14,65 +14,6 @@ ;--% Utility operations on Abstract Syntax Trees -;-- An S-expression which people can read. -;pfSexpr pform == -; strip pform where -; strip pform == -; pfId? pform => pfIdSymbol pform -; pfLiteral? pform => pfLiteralString pform -; pfLeaf? pform => tokPart pform -; -; pfApplication? pform => -; args := -; a := pfApplicationArg pform -; if pfTuple? a then pf0TupleParts a else [a] -; [strip p for p in cons(pfApplicationOp pform, args)] -; -; cons(pfAbSynOp pform, [strip p for p in pfParts pform]) - -(DEFUN |pfSexpr| (|pform|) - (PROG () (RETURN (|pfSexpr,strip| |pform|)))) - -(DEFUN |pfSexpr,strip| (|pform|) - (PROG (|args| |a|) - (RETURN - (COND - ((|pfId?| |pform|) (|pfIdSymbol| |pform|)) - ((|pfLiteral?| |pform|) (|pfLiteralString| |pform|)) - ((|pfLeaf?| |pform|) (|tokPart| |pform|)) - ((|pfApplication?| |pform|) - (PROGN - (SETQ |args| - (PROGN - (SETQ |a| (|pfApplicationArg| |pform|)) - (COND - ((|pfTuple?| |a|) (|pf0TupleParts| |a|)) - ('T (LIST |a|))))) - ((LAMBDA (|bfVar#2| |bfVar#1| |p|) - (LOOP - (COND - ((OR (ATOM |bfVar#1|) - (PROGN (SETQ |p| (CAR |bfVar#1|)) NIL)) - (RETURN (NREVERSE |bfVar#2|))) - ('T - (SETQ |bfVar#2| - (CONS (|pfSexpr,strip| |p|) |bfVar#2|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|)))) - NIL (CONS (|pfApplicationOp| |pform|) |args|) NIL))) - ('T - (CONS (|pfAbSynOp| |pform|) - ((LAMBDA (|bfVar#4| |bfVar#3| |p|) - (LOOP - (COND - ((OR (ATOM |bfVar#3|) - (PROGN (SETQ |p| (CAR |bfVar#3|)) NIL)) - (RETURN (NREVERSE |bfVar#4|))) - ('T - (SETQ |bfVar#4| - (CONS (|pfSexpr,strip| |p|) |bfVar#4|)))) - (SETQ |bfVar#3| (CDR |bfVar#3|)))) - NIL (|pfParts| |pform|) NIL))))))) - ;pfCopyWithPos( pform , pos ) == ; pfLeaf? pform => pfLeaf( pfAbSynOp pform , tokPart pform , pos ) ; pfTree( pfAbSynOp pform , [ pfCopyWithPos( p , pos ) for p in pfParts pform ] ) diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index 2b1f138..e9ad49c 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -191,9 +191,6 @@ documentclass{article} (defmacro maxindex (x) `(the fixnum (1- (the fixnum (length ,x))))) -(defmacro memq (a b) - `(member ,a ,b :test #'eq)) - (defmacro minus (x) `(- ,x))