diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 0052071..f93c00a 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -34506,398 +34506,6 @@ searchCurrentEnv(x,currentEnv) == @ -<>= -(defvar $index 0 "File line number of most recently read line") - -@ - -<>= -(defvar $linelist nil "Stack of preparsed lines") - -@ - -<>= -(defvar echolinestack nil "Stack of lines to list") - -@ - -<>= -(defvar $preparse-last-line nil "Most recently read line") - -@ - -The {\bf initialize-preparse} expects to be called before the {\bf preparse} -function. It initializes the state, in particular, it reads a single line -from the input stream and stores it in {\tt \verb|$preparse-last-line|}. -The caller gives a stream and the {\tt \verb|$preparse-last-line|} variable -is initialized as: -\begin{verbatim} - 2> (INITIALIZE-PREPARSE #) - <2 (INITIALIZE-PREPARSE ")abbrev domain EQ Equation") -\end{verbatim} -\defun{initialize-preparse}{initialize-preparse} -\calls{initialize-preparse}{get-a-line} -\usesdollar{initialize-preparse}{index} -\usesdollar{initialize-preparse}{linelist} -\usesdollar{initialize-preparse}{echolinestack} -\usesdollar{initialize-preparse}{preparse-last-line} -<>= -(defun initialize-preparse (strm) - (setq $index 0) - (setq $linelist nil) - (setq $echolinestack nil) - (setq $preparse-last-line (get-a-line strm))) - -@ - -The {\bf preparse} function returns a list of pairs of the form: -( (linenumber . linestring) .... (linenumber . linestring)) -For instance, for the file {\tt EQ.spad}, we get: -\begin{verbatim} -<2 (PREPARSE ( - (19 . "Equation(S: Type): public == private where") - (20 . " (Ex ==> OutputForm;") - (21 . " public ==> Type with") - (22 . " (\"=\": (S, S) -> $;") - (24 . " equation: (S, S) -> $;") - (26 . " swap: $ -> $;") - (28 . " lhs: $ -> S;") - (30 . " rhs: $ -> S;") - (32 . " map: (S -> S, $) -> $;") - (35 . " if S has InnerEvalable(Symbol,S) then") - (36 . " InnerEvalable(Symbol,S);") - (37 . " if S has SetCategory then") - (38 . " (SetCategory;") - (39 . " CoercibleTo Boolean;") - (40 . " if S has Evalable(S) then") - (41 . " (eval: ($, $) -> $;") - (43 . " eval: ($, List $) -> $));") - (45 . " if S has AbelianSemiGroup then") - (46 . " (AbelianSemiGroup;") - (47 . " \"+\": (S, $) -> $;") - (50 . " \"+\": ($, S) -> $);") - (53 . " if S has AbelianGroup then") - (54 . " (AbelianGroup;") - (55 . " leftZero : $ -> $;") - (57 . " rightZero : $ -> $;") - (59 . " \"-\": (S, $) -> $;") - (62 . " \"-\": ($, S) -> $);") - (65 . " if S has SemiGroup then") - (66 . " (SemiGroup;") - (67 . " \"*\": (S, $) -> $;") - (70 . " \"*\": ($, S) -> $);") - (73 . " if S has Monoid then") - (74 . " (Monoid;") - (75 . " leftOne : $ -> Union($,\"failed\");") - (77 . " rightOne : $ -> Union($,\"failed\"));") - (79 . " if S has Group then") - (80 . " (Group;") - (81 . " leftOne : $ -> Union($,\"failed\");") - (83 . " rightOne : $ -> Union($,\"failed\"));") - (85 . " if S has Ring then") - (86 . " (Ring;") - (87 . " BiModule(S,S));") - (88 . " if S has CommutativeRing then") - (89 . " Module(S);") - (91 . " if S has IntegralDomain then") - (92 . " factorAndSplit : $ -> List $;") - (96 . " if S has PartialDifferentialRing(Symbol) then") - (97 . " PartialDifferentialRing(Symbol);") - (98 . " if S has Field then") - (99 . " (VectorSpace(S);") - (100 . " \"/\": ($, $) -> $;") - (103 . " inv: $ -> $);") - (105 . " if S has ExpressionSpace then") - (106 . " subst: ($, $) -> $);") - (109 . " private ==> add") - (110 . " (Rep := Record(lhs: S, rhs: S);") - (111 . " eq1,eq2: $;") - (112 . " s : S;") - (113 . " if S has IntegralDomain then") - (114 . " factorAndSplit eq ==") - (115 . " ((S has factor : S -> Factored S) =>") - (116 . " (eq0 := rightZero eq;") - (117 . " [equation(rcf.factor,0) - for rcf in factors factor lhs eq0]);") - (118 . " [eq]);") - (119 . " l:S = r:S == [l, r];") - (120 . " equation(l, r) == [l, r];") - (121 . " lhs eqn == eqn.lhs;") - (122 . " rhs eqn == eqn.rhs;") - (123 . " swap eqn == [rhs eqn, lhs eqn];") - (124 . " map(fn, eqn) == equation(fn(eqn.lhs), fn(eqn.rhs));") - (125 . " if S has InnerEvalable(Symbol,S) then") - (126 . " (s:Symbol;") - (127 . " ls:List Symbol;") - (128 . " x:S;") - (129 . " lx:List S;") - (130 . " eval(eqn,s,x) == eval(eqn.lhs,s,x) = eval(eqn.rhs,s,x);") - (131 . " eval(eqn,ls,lx) == eval(eqn.lhs,ls,lx) = - eval(eqn.rhs,ls,lx));") - (132 . " if S has Evalable(S) then") - (133 . " (eval(eqn1:$, eqn2:$):$ ==") - (134 . " eval(eqn1.lhs, eqn2 pretend Equation S) =") - (135 . " eval(eqn1.rhs, eqn2 pretend Equation S);") - (136 . " eval(eqn1:$, leqn2:List $):$ ==") - (137 . " eval(eqn1.lhs, leqn2 pretend List Equation S) =") - (138 . " eval(eqn1.rhs, leqn2 pretend List Equation S));") - (139 . " if S has SetCategory then") - (140 . " (eq1 = eq2 == (eq1.lhs = eq2.lhs)@Boolean and") - (141 . " (eq1.rhs = eq2.rhs)@Boolean;") - (142 . " coerce(eqn:$):Ex == eqn.lhs::Ex = eqn.rhs::Ex;") - (143 . " coerce(eqn:$):Boolean == eqn.lhs = eqn.rhs);") - (144 . " if S has AbelianSemiGroup then") - (145 . " (eq1 + eq2 == eq1.lhs + eq2.lhs = eq1.rhs + eq2.rhs;") - (146 . " s + eq2 == [s,s] + eq2;") - (147 . " eq1 + s == eq1 + [s,s]);") - (148 . " if S has AbelianGroup then") - (149 . " (- eq == (- lhs eq) = (-rhs eq);") - (150 . " s - eq2 == [s,s] - eq2;") - (151 . " eq1 - s == eq1 - [s,s];") - (152 . " leftZero eq == 0 = rhs eq - lhs eq;") - (153 . " rightZero eq == lhs eq - rhs eq = 0;") - (154 . " 0 == equation(0$S,0$S);") - (155 . " eq1 - eq2 == eq1.lhs - eq2.lhs = eq1.rhs - eq2.rhs);") - (156 . " if S has SemiGroup then") - (157 . " (eq1:$ * eq2:$ == eq1.lhs * eq2.lhs = eq1.rhs * eq2.rhs;") - (158 . " l:S * eqn:$ == l * eqn.lhs = l * eqn.rhs;") - (159 . " l:S * eqn:$ == l * eqn.lhs = l * eqn.rhs;") - (160 . " eqn:$ * l:S == eqn.lhs * l = eqn.rhs * l);") - (165 . " if S has Monoid then") - (166 . " (1 == equation(1$S,1$S);") - (167 . " recip eq ==") - (168 . " ((lh := recip lhs eq) case \"failed\" => \"failed\";") - (169 . " (rh := recip rhs eq) case \"failed\" => \"failed\";") - (170 . " [lh :: S, rh :: S]);") - (171 . " leftOne eq ==") - (172 . " ((re := recip lhs eq) case \"failed\" => \"failed\";") - (173 . " 1 = rhs eq * re);") - (174 . " rightOne eq ==") - (175 . " ((re := recip rhs eq) case \"failed\" => \"failed\";") - (176 . " lhs eq * re = 1));") - (177 . " if S has Group then") - (178 . " (inv eq == [inv lhs eq, inv rhs eq];") - (179 . " leftOne eq == 1 = rhs eq * inv rhs eq;") - (180 . " rightOne eq == lhs eq * inv rhs eq = 1);") - (181 . " if S has Ring then") - (182 . " (characteristic() == characteristic()$S;") - (183 . " i:Integer * eq:$ == (i::S) * eq);") - (184 . " if S has IntegralDomain then") - (185 . " factorAndSplit eq ==") - (186 . " ((S has factor : S -> Factored S) =>") - (187 . " (eq0 := rightZero eq;") - (188 . " [equation(rcf.factor,0) - for rcf in factors factor lhs eq0]);") - (189 . " (S has Polynomial Integer) =>") - (190 . " (eq0 := rightZero eq;") - (191 . " MF ==> MultivariateFactorize(Symbol, - IndexedExponents Symbol, - Integer, Polynomial Integer);") - (193 . " p : Polynomial Integer := - (lhs eq0) pretend Polynomial Integer;") - (194 . " [equation((rcf.factor) pretend S,0) - for rcf in factors factor(p)$MF]);") - (195 . " [eq]);") - (196 . " if S has PartialDifferentialRing(Symbol) then") - (197 . " differentiate(eq:$, sym:Symbol):$ ==") - (198 . " [differentiate(lhs eq, sym), differentiate(rhs eq, sym)];") - (199 . " if S has Field then") - (200 . " (dimension() == 2 :: CardinalNumber;") - (201 . " eq1:$ / eq2:$ == eq1.lhs / eq2.lhs = eq1.rhs / eq2.rhs;") - (202 . " inv eq == [inv lhs eq, inv rhs eq]);") - (203 . " if S has ExpressionSpace then") - (204 . " subst(eq1,eq2) ==") - (205 . " (eq3 := eq2 pretend Equation S;") - (206 . " [subst(lhs eq1,eq3),subst(rhs eq1,eq3)])))"))) -\end{verbatim} - -\defun{preparse}{preparse} -\calls{preparse}{preparse} -\calls{preparse}{preparse1} -\calls{preparse}{parseprint} -\calls{preparse}{ifcar} -\usesdollar{preparse}{comblocklist} -\usesdollar{preparse}{skipme} -\usesdollar{preparse}{preparse-last-line} -\usesdollar{preparse}{index} -\usesdollar{preparse}{docList} -\usesdollar{preparse}{preparseReportIfTrue} -\usesdollar{preparse}{headerDocumentation} -\usesdollar{preparse}{maxSignatureLineNumber} -\usesdollar{preparse}{constructorLineNumber} -<>= -(defun preparse (strm &aux (stack ())) - (declare (special $comblocklist $skipme $preparse-last-line $index |$docList| - $preparseReportIfTrue |$headerDocumentation| - |$maxSignatureLineNumber| |$constructorLineNumber|)) - (setq $comblocklist nil) - (setq $skipme nil) - (when $preparse-last-line - (if (pairp $preparse-last-line) - (setq stack $preparse-last-line) - (push $preparse-last-line stack)) - (setq $index (- $index (length stack)))) - (let ((u (preparse1 stack))) - (if $skipme - (preparse strm) - (progn - (when $preparseReportIfTrue (parseprint u)) - (setq |$headerDocumentation| nil) - (setq |$docList| nil) - (setq |$maxSignatureLineNumber| 0) - (setq |$constructorLineNumber| (ifcar (ifcar u))) - u)))) - -@ - -\defun{preparse1}{Build the lines from the input for piles} -\calls{preparse1}{preparseReadLine} -\calls{preparse1}{atEndOfUnit} -\calls{preparse1}{preparse-echo} -\calls{preparse1}{fincomblock} -\calls{preparse1}{parsepiles} -\calls{preparse1}{doSystemCommand} -\calls{preparse1}{escaped} -\calls{preparse1}{instring} -\calls{preparse1}{indent-pos} -\calls{preparse1}{getfullstr} -\calls{preparse1}{droptrailingblanks} -\calls{preparse1}{maxindex} -\calls{preparse1}{strposl} -\calls{preparse1}{is-console} -\catches{preparse1}{spad-reader} -\usesdollar{preparse1}{linelist} -\usesdollar{preparse1}{echolinestack} -\usesdollar{preparse1}{byConstructors} -\usesdollar{preparse1}{skipme} -\usesdollar{preparse1}{constructorsSeen} -\usesdollar{preparse1}{preparse-last-line} -<>= -(defun preparse1 (linelist) - (prog (($linelist linelist) $echolinestack num a i l psloc - instring pcount comsym strsym oparsym cparsym n ncomsym - (sloc -1) (continue nil) (parenlev 0) (ncomblock ()) - (lines ()) (locs ()) (nums ()) functor) - (declare (special $linelist $echolinestack |$byConstructors| $skipme - |$constructorsSeen| $preparse-last-line)) -READLOOP - (dcq (num . a) (preparseReadLine linelist)) - (when (atEndOfUnit a) - (preparse-echo linelist) - (cond - ((null lines) (return nil)) - (ncomblock (fincomblock nil nums locs ncomblock nil))) - (return - (pair (nreverse nums) (parsepiles (nreverse locs) (nreverse lines))))) - ; this is a command line, don't parse it - (when (and (null lines) (> (length a) 0) (eq (char a 0) #\) )) - (preparse-echo linelist) - (setq $preparse-last-line nil) ;don't reread this line - (setq line a) - (catch 'spad_reader (|doSystemCommand| (subseq line 1))) - (go READLOOP)) - (setq l (length a)) - ; if we get a null line, read the next line - (when (eq l 0) (go READLOOP)) - ; otherwise we have to parse this line - (setq psloc sloc) - (setq i 0) - (setq instring nil) - (setq pcount 0) -STRLOOP ;; handle things that need ignoring, quoting, or grouping - ; are we in a comment, quoting, or grouping situation? - (setq strsym (or (position #\" a :start i ) l)) - (setq comsym (or (search "--" a :start2 i ) l)) - (setq ncomsym (or (search "++" a :start2 i ) l)) - (setq oparsym (or (position #\( a :start i ) l)) - (setq cparsym (or (position #\) a :start i ) l)) - (setq n (min strsym comsym ncomsym oparsym cparsym)) - (cond - ; nope, we found no comment, quoting, or grouping - ((= n l) (go NOCOMS)) - ((escaped a n)) - ; scan until we hit the end of the string - ((= n strsym) (setq instring (not instring))) - (instring) - ;; handle -- comments by ignoring them - ((= n comsym) - (setq a (subseq a 0 n)) - (go NOCOMS)) ; discard trailing comment - ;; handle ++ comments by chunking them together - ((= n ncomsym) - (setq sloc (indent-pos a)) - (cond - ((= sloc n) - (when (and ncomblock (not (= n (car ncomblock)))) - (fincomblock num nums locs ncomblock linelist) - (setq ncomblock nil)) - (setq ncomblock (cons n (cons a (ifcdr ncomblock)))) - (setq a "")) - (t - (push (strconc (getfullstr n " ") (substring a n ())) $linelist) - (setq $index (1- $index)) - (setq a (subseq a 0 n)))) - (go NOCOMS)) - ; know how deep we are into parens - ((= n oparsym) (setq pcount (1+ pcount))) - ((= n cparsym) (setq pcount (1- pcount)))) - (setq i (1+ n)) - (go STRLOOP) -NOCOMS - ; remember the indentation level - (setq sloc (indent-pos a)) - (setq a (droptrailingblanks a)) - (when (null sloc) - (setq sloc psloc) - (go READLOOP)) - ; handle line that ends in a continuation character - (cond - ((eq (elt a (maxindex a)) xcape) - (setq continue t) - (setq a (subseq a (maxindex a)))) - ((setq continue nil))) - ; test for skipping constructors - (when (and (null lines) (= sloc 0)) - (if (and |$byConstructors| - (null (search "==>" a)) - (not - (member - (setq functor - (intern (substring a 0 (strposl ": (=" a 0 nil)))) - |$byConstructors|))) - (setq $skipme 't) - (progn - (push functor |$constructorsSeen|) - (setq $skipme nil)))) - ; is this thing followed by ++ comments? - (when (and lines (eql sloc 0)) - (when (and ncomblock (not (zerop (car ncomblock)))) - (fincomblock num nums locs ncomblock linelist)) - (when (not (is-console in-stream)) - (setq $preparse-last-line (nreverse $echolinestack))) - (return - (pair (nreverse nums) (parsepiles (nreverse locs) (nreverse lines))))) - (when (> parenlev 0) - (push nil locs) - (setq sloc psloc) - (go REREAD)) - (when ncomblock - (fincomblock num nums locs ncomblock linelist) - (setq ncomblock ())) - (push sloc locs) -REREAD - (preparse-echo linelist) - (push a lines) - (push num nums) - (setq parenlev (+ parenlev pcount)) - (when (and (is-console in-stream) (not continue)) - (setq $preparse-last-line nil) - (return - (pair (nreverse nums) (parsepiles (nreverse locs) (nreverse lines))))) - (go READLOOP))) - -@ - \chapter{Handling output} \section{Special Character Tables} @@ -40273,7 +39881,6 @@ This needs to work off the internal exposure list, not the file. <> <> <> -<> <> <> <> @@ -40806,8 +40413,6 @@ This needs to work off the internal exposure list, not the file. <> <> <> -<> -<> <> <> <> diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 2b7800a..5aadbca 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -427,6 +427,7 @@ the spad compiler does when it encounters an error. should stop at the first error. The value of the {\tt )set break} variable then controls what happens. +\chapter{The Parser} \section{EQ.spad} We will explain the compilation function using the file {\tt EQ.spad}. We trace the execution of the various functions to understand the actual @@ -645,6 +646,570 @@ Equation(S: Type): public == private where \end{verbatim} +<>= +(defvar $index 0 "File line number of most recently read line") + +@ + +<>= +(defvar $linelist nil "Stack of preparsed lines") + +@ + +<>= +(defvar $echolinestack nil "Stack of lines to list") + +@ + +<>= +(defvar $preparse-last-line nil "Most recently read line") + +@ + +\section{Parsing routines} +The {\bf initialize-preparse} expects to be called before the {\bf preparse} +function. It initializes the state, in particular, it reads a single line +from the input stream and stores it in {\tt \verb|$preparse-last-line|}. +The caller gives a stream and the {\tt \verb|$preparse-last-line|} variable +is initialized as: +\begin{verbatim} + 2> (INITIALIZE-PREPARSE #) + <2 (INITIALIZE-PREPARSE ")abbrev domain EQ Equation") +\end{verbatim} +\defun{initialize-preparse}{initialize-preparse} +\calls{initialize-preparse}{get-a-line} +\usesdollar{initialize-preparse}{index} +\usesdollar{initialize-preparse}{linelist} +\usesdollar{initialize-preparse}{echolinestack} +\usesdollar{initialize-preparse}{preparse-last-line} +<>= +(defun initialize-preparse (strm) + (setq $index 0) + (setq $linelist nil) + (setq $echolinestack nil) + (setq $preparse-last-line (get-a-line strm))) + +@ + +The {\bf preparse} function returns a list of pairs of the form: +( (linenumber . linestring) .... (linenumber . linestring)) +For instance, for the file {\tt EQ.spad}, we get: +\begin{verbatim} + 2> (PREPARSE #) + 3> (PREPARSE1 (")abbrev domain EQ Equation")) + 4> (|doSystemCommand| "abbrev domain EQ Equation") + <4 (|doSystemCommand| NIL) + <3 (PREPARSE1 ( ...[snip]... ) + <2 (PREPARSE ( + (19 . "Equation(S: Type): public == private where") + (20 . " (Ex ==> OutputForm;") + (21 . " public ==> Type with") + (22 . " (\"=\": (S, S) -> $;") + (24 . " equation: (S, S) -> $;") + (26 . " swap: $ -> $;") + (28 . " lhs: $ -> S;") + (30 . " rhs: $ -> S;") + (32 . " map: (S -> S, $) -> $;") + (35 . " if S has InnerEvalable(Symbol,S) then") + (36 . " InnerEvalable(Symbol,S);") + (37 . " if S has SetCategory then") + (38 . " (SetCategory;") + (39 . " CoercibleTo Boolean;") + (40 . " if S has Evalable(S) then") + (41 . " (eval: ($, $) -> $;") + (43 . " eval: ($, List $) -> $));") + (45 . " if S has AbelianSemiGroup then") + (46 . " (AbelianSemiGroup;") + (47 . " \"+\": (S, $) -> $;") + (50 . " \"+\": ($, S) -> $);") + (53 . " if S has AbelianGroup then") + (54 . " (AbelianGroup;") + (55 . " leftZero : $ -> $;") + (57 . " rightZero : $ -> $;") + (59 . " \"-\": (S, $) -> $;") + (62 . " \"-\": ($, S) -> $);") + (65 . " if S has SemiGroup then") + (66 . " (SemiGroup;") + (67 . " \"*\": (S, $) -> $;") + (70 . " \"*\": ($, S) -> $);") + (73 . " if S has Monoid then") + (74 . " (Monoid;") + (75 . " leftOne : $ -> Union($,\"failed\");") + (77 . " rightOne : $ -> Union($,\"failed\"));") + (79 . " if S has Group then") + (80 . " (Group;") + (81 . " leftOne : $ -> Union($,\"failed\");") + (83 . " rightOne : $ -> Union($,\"failed\"));") + (85 . " if S has Ring then") + (86 . " (Ring;") + (87 . " BiModule(S,S));") + (88 . " if S has CommutativeRing then") + (89 . " Module(S);") + (91 . " if S has IntegralDomain then") + (92 . " factorAndSplit : $ -> List $;") + (96 . " if S has PartialDifferentialRing(Symbol) then") + (97 . " PartialDifferentialRing(Symbol);") + (98 . " if S has Field then") + (99 . " (VectorSpace(S);") + (100 . " \"/\": ($, $) -> $;") + (103 . " inv: $ -> $);") + (105 . " if S has ExpressionSpace then") + (106 . " subst: ($, $) -> $);") + (109 . " private ==> add") + (110 . " (Rep := Record(lhs: S, rhs: S);") + (111 . " eq1,eq2: $;") + (112 . " s : S;") + (113 . " if S has IntegralDomain then") + (114 . " factorAndSplit eq ==") + (115 . " ((S has factor : S -> Factored S) =>") + (116 . " (eq0 := rightZero eq;") + (117 . " [equation(rcf.factor,0) + for rcf in factors factor lhs eq0]);") + (118 . " [eq]);") + (119 . " l:S = r:S == [l, r];") + (120 . " equation(l, r) == [l, r];") + (121 . " lhs eqn == eqn.lhs;") + (122 . " rhs eqn == eqn.rhs;") + (123 . " swap eqn == [rhs eqn, lhs eqn];") + (124 . " map(fn, eqn) == equation(fn(eqn.lhs), fn(eqn.rhs));") + (125 . " if S has InnerEvalable(Symbol,S) then") + (126 . " (s:Symbol;") + (127 . " ls:List Symbol;") + (128 . " x:S;") + (129 . " lx:List S;") + (130 . " eval(eqn,s,x) == eval(eqn.lhs,s,x) = eval(eqn.rhs,s,x);") + (131 . " eval(eqn,ls,lx) == eval(eqn.lhs,ls,lx) = + eval(eqn.rhs,ls,lx));") + (132 . " if S has Evalable(S) then") + (133 . " (eval(eqn1:$, eqn2:$):$ ==") + (134 . " eval(eqn1.lhs, eqn2 pretend Equation S) =") + (135 . " eval(eqn1.rhs, eqn2 pretend Equation S);") + (136 . " eval(eqn1:$, leqn2:List $):$ ==") + (137 . " eval(eqn1.lhs, leqn2 pretend List Equation S) =") + (138 . " eval(eqn1.rhs, leqn2 pretend List Equation S));") + (139 . " if S has SetCategory then") + (140 . " (eq1 = eq2 == (eq1.lhs = eq2.lhs)@Boolean and") + (141 . " (eq1.rhs = eq2.rhs)@Boolean;") + (142 . " coerce(eqn:$):Ex == eqn.lhs::Ex = eqn.rhs::Ex;") + (143 . " coerce(eqn:$):Boolean == eqn.lhs = eqn.rhs);") + (144 . " if S has AbelianSemiGroup then") + (145 . " (eq1 + eq2 == eq1.lhs + eq2.lhs = eq1.rhs + eq2.rhs;") + (146 . " s + eq2 == [s,s] + eq2;") + (147 . " eq1 + s == eq1 + [s,s]);") + (148 . " if S has AbelianGroup then") + (149 . " (- eq == (- lhs eq) = (-rhs eq);") + (150 . " s - eq2 == [s,s] - eq2;") + (151 . " eq1 - s == eq1 - [s,s];") + (152 . " leftZero eq == 0 = rhs eq - lhs eq;") + (153 . " rightZero eq == lhs eq - rhs eq = 0;") + (154 . " 0 == equation(0$S,0$S);") + (155 . " eq1 - eq2 == eq1.lhs - eq2.lhs = eq1.rhs - eq2.rhs);") + (156 . " if S has SemiGroup then") + (157 . " (eq1:$ * eq2:$ == eq1.lhs * eq2.lhs = eq1.rhs * eq2.rhs;") + (158 . " l:S * eqn:$ == l * eqn.lhs = l * eqn.rhs;") + (159 . " l:S * eqn:$ == l * eqn.lhs = l * eqn.rhs;") + (160 . " eqn:$ * l:S == eqn.lhs * l = eqn.rhs * l);") + (165 . " if S has Monoid then") + (166 . " (1 == equation(1$S,1$S);") + (167 . " recip eq ==") + (168 . " ((lh := recip lhs eq) case \"failed\" => \"failed\";") + (169 . " (rh := recip rhs eq) case \"failed\" => \"failed\";") + (170 . " [lh :: S, rh :: S]);") + (171 . " leftOne eq ==") + (172 . " ((re := recip lhs eq) case \"failed\" => \"failed\";") + (173 . " 1 = rhs eq * re);") + (174 . " rightOne eq ==") + (175 . " ((re := recip rhs eq) case \"failed\" => \"failed\";") + (176 . " lhs eq * re = 1));") + (177 . " if S has Group then") + (178 . " (inv eq == [inv lhs eq, inv rhs eq];") + (179 . " leftOne eq == 1 = rhs eq * inv rhs eq;") + (180 . " rightOne eq == lhs eq * inv rhs eq = 1);") + (181 . " if S has Ring then") + (182 . " (characteristic() == characteristic()$S;") + (183 . " i:Integer * eq:$ == (i::S) * eq);") + (184 . " if S has IntegralDomain then") + (185 . " factorAndSplit eq ==") + (186 . " ((S has factor : S -> Factored S) =>") + (187 . " (eq0 := rightZero eq;") + (188 . " [equation(rcf.factor,0) + for rcf in factors factor lhs eq0]);") + (189 . " (S has Polynomial Integer) =>") + (190 . " (eq0 := rightZero eq;") + (191 . " MF ==> MultivariateFactorize(Symbol, + IndexedExponents Symbol, + Integer, Polynomial Integer);") + (193 . " p : Polynomial Integer := + (lhs eq0) pretend Polynomial Integer;") + (194 . " [equation((rcf.factor) pretend S,0) + for rcf in factors factor(p)$MF]);") + (195 . " [eq]);") + (196 . " if S has PartialDifferentialRing(Symbol) then") + (197 . " differentiate(eq:$, sym:Symbol):$ ==") + (198 . " [differentiate(lhs eq, sym), differentiate(rhs eq, sym)];") + (199 . " if S has Field then") + (200 . " (dimension() == 2 :: CardinalNumber;") + (201 . " eq1:$ / eq2:$ == eq1.lhs / eq2.lhs = eq1.rhs / eq2.rhs;") + (202 . " inv eq == [inv lhs eq, inv rhs eq]);") + (203 . " if S has ExpressionSpace then") + (204 . " subst(eq1,eq2) ==") + (205 . " (eq3 := eq2 pretend Equation S;") + (206 . " [subst(lhs eq1,eq3),subst(rhs eq1,eq3)])))"))) +\end{verbatim} + +\defun{preparse}{preparse} +\calls{preparse}{preparse} +\calls{preparse}{preparse1} +\calls{preparse}{parseprint} +\calls{preparse}{ifcar} +\usesdollar{preparse}{comblocklist} +\usesdollar{preparse}{skipme} +\usesdollar{preparse}{preparse-last-line} +\usesdollar{preparse}{index} +\usesdollar{preparse}{docList} +\usesdollar{preparse}{preparseReportIfTrue} +\usesdollar{preparse}{headerDocumentation} +\usesdollar{preparse}{maxSignatureLineNumber} +\usesdollar{preparse}{constructorLineNumber} +<>= +(defun preparse (strm &aux (stack ())) + (declare (special $comblocklist $skipme $preparse-last-line $index |$docList| + $preparseReportIfTrue |$headerDocumentation| + |$maxSignatureLineNumber| |$constructorLineNumber|)) + (setq $comblocklist nil) + (setq $skipme nil) + (when $preparse-last-line + (if (pairp $preparse-last-line) + (setq stack $preparse-last-line) + (push $preparse-last-line stack)) + (setq $index (- $index (length stack)))) + (let ((u (preparse1 stack))) + (if $skipme + (preparse strm) + (progn + (when $preparseReportIfTrue (parseprint u)) + (setq |$headerDocumentation| nil) + (setq |$docList| nil) + (setq |$maxSignatureLineNumber| 0) + (setq |$constructorLineNumber| (ifcar (ifcar u))) + u)))) + +@ + +The {\bf preparse} function returns a list of pairs of the form: +( (linenumber . linestring) .... (linenumber . linestring)) +For instance, for the file {\tt EQ.spad}, we get: +\begin{verbatim} + 2> (PREPARSE #) + 3> (PREPARSE1 (")abbrev domain EQ Equation")) + 4> (|doSystemCommand| "abbrev domain EQ Equation") + <4 (|doSystemCommand| NIL) + <3 (PREPARSE1 ( + (19 . "Equation(S: Type): public == private where") + (20 . " (Ex ==> OutputForm;") + (21 . " public ==> Type with") + (22 . " (\"=\": (S, S) -> $;") + (24 . " equation: (S, S) -> $;") + (26 . " swap: $ -> $;") + (28 . " lhs: $ -> S;") + (30 . " rhs: $ -> S;") + (32 . " map: (S -> S, $) -> $;") + (35 . " if S has InnerEvalable(Symbol,S) then") + (36 . " InnerEvalable(Symbol,S);") + (37 . " if S has SetCategory then") + (38 . " (SetCategory;") + (39 . " CoercibleTo Boolean;") + (40 . " if S has Evalable(S) then") + (41 . " (eval: ($, $) -> $;") + (43 . " eval: ($, List $) -> $));") + (45 . " if S has AbelianSemiGroup then") + (46 . " (AbelianSemiGroup;") + (47 . " \"+\": (S, $) -> $;") + (50 . " \"+\": ($, S) -> $);") + (53 . " if S has AbelianGroup then") + (54 . " (AbelianGroup;") + (55 . " leftZero : $ -> $;") + (57 . " rightZero : $ -> $;") + (59 . " \"-\": (S, $) -> $;") + (62 . " \"-\": ($, S) -> $);") + (65 . " if S has SemiGroup then") + (66 . " (SemiGroup;") + (67 . " \"*\": (S, $) -> $;") + (70 . " \"*\": ($, S) -> $);") + (73 . " if S has Monoid then") + (74 . " (Monoid;") + (75 . " leftOne : $ -> Union($,\"failed\");") + (77 . " rightOne : $ -> Union($,\"failed\"));") + (79 . " if S has Group then") + (80 . " (Group;") + (81 . " leftOne : $ -> Union($,\"failed\");") + (83 . " rightOne : $ -> Union($,\"failed\"));") + (85 . " if S has Ring then") + (86 . " (Ring;") + (87 . " BiModule(S,S));") + (88 . " if S has CommutativeRing then") + (89 . " Module(S);") + (91 . " if S has IntegralDomain then") + (92 . " factorAndSplit : $ -> List $;") + (96 . " if S has PartialDifferentialRing(Symbol) then") + (97 . " PartialDifferentialRing(Symbol);") + (98 . " if S has Field then") + (99 . " (VectorSpace(S);") + (100 . " \"/\": ($, $) -> $;") + (103 . " inv: $ -> $);") + (105 . " if S has ExpressionSpace then") + (106 . " subst: ($, $) -> $);") + (109 . " private ==> add") + (110 . " (Rep := Record(lhs: S, rhs: S);") + (111 . " eq1,eq2: $;") + (112 . " s : S;") + (113 . " if S has IntegralDomain then") + (114 . " factorAndSplit eq ==") + (115 . " ((S has factor : S -> Factored S) =>") + (116 . " (eq0 := rightZero eq;") + (117 . " [equation(rcf.factor,0) + for rcf in factors factor lhs eq0]);") + (118 . " [eq]);") + (119 . " l:S = r:S == [l, r];") + (120 . " equation(l, r) == [l, r];") + (121 . " lhs eqn == eqn.lhs;") + (122 . " rhs eqn == eqn.rhs;") + (123 . " swap eqn == [rhs eqn, lhs eqn];") + (124 . " map(fn, eqn) == equation(fn(eqn.lhs), fn(eqn.rhs));") + (125 . " if S has InnerEvalable(Symbol,S) then") + (126 . " (s:Symbol;") + (127 . " ls:List Symbol;") + (128 . " x:S;") + (129 . " lx:List S;") + (130 . " eval(eqn,s,x) == eval(eqn.lhs,s,x) = eval(eqn.rhs,s,x);") + (131 . " eval(eqn,ls,lx) == eval(eqn.lhs,ls,lx) = + eval(eqn.rhs,ls,lx));") + (132 . " if S has Evalable(S) then") + (133 . " (eval(eqn1:$, eqn2:$):$ ==") + (134 . " eval(eqn1.lhs, eqn2 pretend Equation S) =") + (135 . " eval(eqn1.rhs, eqn2 pretend Equation S);") + (136 . " eval(eqn1:$, leqn2:List $):$ ==") + (137 . " eval(eqn1.lhs, leqn2 pretend List Equation S) =") + (138 . " eval(eqn1.rhs, leqn2 pretend List Equation S));") + (139 . " if S has SetCategory then") + (140 . " (eq1 = eq2 == (eq1.lhs = eq2.lhs)@Boolean and") + (141 . " (eq1.rhs = eq2.rhs)@Boolean;") + (142 . " coerce(eqn:$):Ex == eqn.lhs::Ex = eqn.rhs::Ex;") + (143 . " coerce(eqn:$):Boolean == eqn.lhs = eqn.rhs);") + (144 . " if S has AbelianSemiGroup then") + (145 . " (eq1 + eq2 == eq1.lhs + eq2.lhs = eq1.rhs + eq2.rhs;") + (146 . " s + eq2 == [s,s] + eq2;") + (147 . " eq1 + s == eq1 + [s,s]);") + (148 . " if S has AbelianGroup then") + (149 . " (- eq == (- lhs eq) = (-rhs eq);") + (150 . " s - eq2 == [s,s] - eq2;") + (151 . " eq1 - s == eq1 - [s,s];") + (152 . " leftZero eq == 0 = rhs eq - lhs eq;") + (153 . " rightZero eq == lhs eq - rhs eq = 0;") + (154 . " 0 == equation(0$S,0$S);") + (155 . " eq1 - eq2 == eq1.lhs - eq2.lhs = eq1.rhs - eq2.rhs);") + (156 . " if S has SemiGroup then") + (157 . " (eq1:$ * eq2:$ == eq1.lhs * eq2.lhs = eq1.rhs * eq2.rhs;") + (158 . " l:S * eqn:$ == l * eqn.lhs = l * eqn.rhs;") + (159 . " l:S * eqn:$ == l * eqn.lhs = l * eqn.rhs;") + (160 . " eqn:$ * l:S == eqn.lhs * l = eqn.rhs * l);") + (165 . " if S has Monoid then") + (166 . " (1 == equation(1$S,1$S);") + (167 . " recip eq ==") + (168 . " ((lh := recip lhs eq) case \"failed\" => \"failed\";") + (169 . " (rh := recip rhs eq) case \"failed\" => \"failed\";") + (170 . " [lh :: S, rh :: S]);") + (171 . " leftOne eq ==") + (172 . " ((re := recip lhs eq) case \"failed\" => \"failed\";") + (173 . " 1 = rhs eq * re);") + (174 . " rightOne eq ==") + (175 . " ((re := recip rhs eq) case \"failed\" => \"failed\";") + (176 . " lhs eq * re = 1));") + (177 . " if S has Group then") + (178 . " (inv eq == [inv lhs eq, inv rhs eq];") + (179 . " leftOne eq == 1 = rhs eq * inv rhs eq;") + (180 . " rightOne eq == lhs eq * inv rhs eq = 1);") + (181 . " if S has Ring then") + (182 . " (characteristic() == characteristic()$S;") + (183 . " i:Integer * eq:$ == (i::S) * eq);") + (184 . " if S has IntegralDomain then") + (185 . " factorAndSplit eq ==") + (186 . " ((S has factor : S -> Factored S) =>") + (187 . " (eq0 := rightZero eq;") + (188 . " [equation(rcf.factor,0) + for rcf in factors factor lhs eq0]);") + (189 . " (S has Polynomial Integer) =>") + (190 . " (eq0 := rightZero eq;") + (191 . " MF ==> MultivariateFactorize(Symbol, + IndexedExponents Symbol, + Integer, Polynomial Integer);") + (193 . " p : Polynomial Integer := + (lhs eq0) pretend Polynomial Integer;") + (194 . " [equation((rcf.factor) pretend S,0) + for rcf in factors factor(p)$MF]);") + (195 . " [eq]);") + (196 . " if S has PartialDifferentialRing(Symbol) then") + (197 . " differentiate(eq:$, sym:Symbol):$ ==") + (198 . " [differentiate(lhs eq, sym), differentiate(rhs eq, sym)];") + (199 . " if S has Field then") + (200 . " (dimension() == 2 :: CardinalNumber;") + (201 . " eq1:$ / eq2:$ == eq1.lhs / eq2.lhs = eq1.rhs / eq2.rhs;") + (202 . " inv eq == [inv lhs eq, inv rhs eq]);") + (203 . " if S has ExpressionSpace then") + (204 . " subst(eq1,eq2) ==") + (205 . " (eq3 := eq2 pretend Equation S;") + (206 . " [subst(lhs eq1,eq3),subst(rhs eq1,eq3)])))"))) +\end{verbatim} + +\defun{preparse1}{Build the lines from the input for piles} +\calls{preparse1}{preparseReadLine} +\calls{preparse1}{atEndOfUnit} +\calls{preparse1}{preparse-echo} +\calls{preparse1}{fincomblock} +\calls{preparse1}{parsepiles} +\calls{preparse1}{doSystemCommand} +\calls{preparse1}{escaped} +\calls{preparse1}{instring} +\calls{preparse1}{indent-pos} +\calls{preparse1}{getfullstr} +\calls{preparse1}{droptrailingblanks} +\calls{preparse1}{maxindex} +\calls{preparse1}{strposl} +\calls{preparse1}{is-console} +\catches{preparse1}{spad-reader} +\usesdollar{preparse1}{linelist} +\usesdollar{preparse1}{echolinestack} +\usesdollar{preparse1}{byConstructors} +\usesdollar{preparse1}{skipme} +\usesdollar{preparse1}{constructorsSeen} +\usesdollar{preparse1}{preparse-last-line} +<>= +(defun preparse1 (linelist) + (prog (($linelist linelist) $echolinestack num a i l psloc + instring pcount comsym strsym oparsym cparsym n ncomsym + (sloc -1) (continue nil) (parenlev 0) (ncomblock ()) + (lines ()) (locs ()) (nums ()) functor) + (declare (special $linelist $echolinestack |$byConstructors| $skipme + |$constructorsSeen| $preparse-last-line)) +READLOOP + (dcq (num . a) (preparseReadLine linelist)) + (when (atEndOfUnit a) + (preparse-echo linelist) + (cond + ((null lines) (return nil)) + (ncomblock (fincomblock nil nums locs ncomblock nil))) + (return + (pair (nreverse nums) (parsepiles (nreverse locs) (nreverse lines))))) + ; this is a command line, don't parse it + (when (and (null lines) (> (length a) 0) (eq (char a 0) #\) )) + (preparse-echo linelist) + (setq $preparse-last-line nil) ;don't reread this line + (setq line a) + (catch 'spad_reader (|doSystemCommand| (subseq line 1))) + (go READLOOP)) + (setq l (length a)) + ; if we get a null line, read the next line + (when (eq l 0) (go READLOOP)) + ; otherwise we have to parse this line + (setq psloc sloc) + (setq i 0) + (setq instring nil) + (setq pcount 0) +STRLOOP ;; handle things that need ignoring, quoting, or grouping + ; are we in a comment, quoting, or grouping situation? + (setq strsym (or (position #\" a :start i ) l)) + (setq comsym (or (search "--" a :start2 i ) l)) + (setq ncomsym (or (search "++" a :start2 i ) l)) + (setq oparsym (or (position #\( a :start i ) l)) + (setq cparsym (or (position #\) a :start i ) l)) + (setq n (min strsym comsym ncomsym oparsym cparsym)) + (cond + ; nope, we found no comment, quoting, or grouping + ((= n l) (go NOCOMS)) + ((escaped a n)) + ; scan until we hit the end of the string + ((= n strsym) (setq instring (not instring))) + (instring) + ;; handle -- comments by ignoring them + ((= n comsym) + (setq a (subseq a 0 n)) + (go NOCOMS)) ; discard trailing comment + ;; handle ++ comments by chunking them together + ((= n ncomsym) + (setq sloc (indent-pos a)) + (cond + ((= sloc n) + (when (and ncomblock (not (= n (car ncomblock)))) + (fincomblock num nums locs ncomblock linelist) + (setq ncomblock nil)) + (setq ncomblock (cons n (cons a (ifcdr ncomblock)))) + (setq a "")) + (t + (push (strconc (getfullstr n " ") (substring a n ())) $linelist) + (setq $index (1- $index)) + (setq a (subseq a 0 n)))) + (go NOCOMS)) + ; know how deep we are into parens + ((= n oparsym) (setq pcount (1+ pcount))) + ((= n cparsym) (setq pcount (1- pcount)))) + (setq i (1+ n)) + (go STRLOOP) +NOCOMS + ; remember the indentation level + (setq sloc (indent-pos a)) + (setq a (droptrailingblanks a)) + (when (null sloc) + (setq sloc psloc) + (go READLOOP)) + ; handle line that ends in a continuation character + (cond + ((eq (elt a (maxindex a)) xcape) + (setq continue t) + (setq a (subseq a (maxindex a)))) + ((setq continue nil))) + ; test for skipping constructors + (when (and (null lines) (= sloc 0)) + (if (and |$byConstructors| + (null (search "==>" a)) + (not + (member + (setq functor + (intern (substring a 0 (strposl ": (=" a 0 nil)))) + |$byConstructors|))) + (setq $skipme 't) + (progn + (push functor |$constructorsSeen|) + (setq $skipme nil)))) + ; is this thing followed by ++ comments? + (when (and lines (eql sloc 0)) + (when (and ncomblock (not (zerop (car ncomblock)))) + (fincomblock num nums locs ncomblock linelist)) + (when (not (is-console in-stream)) + (setq $preparse-last-line (nreverse $echolinestack))) + (return + (pair (nreverse nums) (parsepiles (nreverse locs) (nreverse lines))))) + (when (> parenlev 0) + (push nil locs) + (setq sloc psloc) + (go REREAD)) + (when ncomblock + (fincomblock num nums locs ncomblock linelist) + (setq ncomblock ())) + (push sloc locs) +REREAD + (preparse-echo linelist) + (push a lines) + (push num nums) + (setq parenlev (+ parenlev pcount)) + (when (and (is-console in-stream) (not continue)) + (setq $preparse-last-line nil) + (return + (pair (nreverse nums) (parsepiles (nreverse locs) (nreverse lines))))) + (go READLOOP))) + +@ + +\chapter{The Compiler} \section{Compiling EQ.spad} Given the top level command: @@ -3696,7 +4261,7 @@ if \verb|$InteractiveMode| then use a null outputstream (defvar |$constructorsSeen| () "list of constructors found") @ -\chapter{The Compiler} + <>= (in-package "BOOT") @@ -3748,10 +4313,14 @@ if \verb|$InteractiveMode| then use a null outputstream <> +<> + <> <> +<> +<> <> <> diff --git a/changelog b/changelog index 636d259..6d86d66 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20100930 tpd src/axiom-website/patches.html 20100930.02.tpd.patch +20100930 tpd books/bookvol9 document compiler +20100930 tpd books/bookvol5 document compiler related routines 20100930 tpd src/axiom-website/patches.html 20100930.01.tpd.patch 20100930 tpd books/bookvolbib add Jenks [Jen69] 20100929 tpd src/axiom-website/patches.html 20100929.01.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 6bb2e6b..a6a02f0 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3170,5 +3170,7 @@ books/bookvol9.pamphlet treeshake compiler
books/bookvol9 document compiler
20100930.01.tpd.patch books/bookvolbib add Jenks [Jen69]
+20100930.02.tpd.patch +books/bookvol9.pamphlet treeshake compiler