diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index c296aba..67bacbd 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -19532,6 +19532,66 @@ deleting entries from u assumes that the first element is useless \end{chunk} +\defun{checkRewrite}{checkRewrite} +\calls{checkRewrite}{checkRemoveComments} +\calls{checkRewrite}{checkAddIndented} +\calls{checkRewrite}{checkGetArgs} +\calls{checkRewrite}{newString2Words} +\calls{checkRewrite}{checkAddSpaces} +\calls{checkRewrite}{checkSplit2Words} +\calls{checkRewrite}{checkAddMacros} +\calls{checkRewrite}{checkTexht} +\calls{checkRewrite}{checkArguments} +\calls{checkRewrite}{checkFixCommonProblem} +\calls{checkRewrite}{checkRecordHash} +\calls{checkRewrite}{checkDecorateForHt} +\refsdollar{checkRewrite}{checkErrorFlag} +\refsdollar{checkRewrite}{argl} +\refsdollar{checkRewrite}{checkingXmptex?} +\begin{chunk}{defun checkRewrite} +(defun |checkRewrite| (name lines) + (declare (ignore name)) + (prog (|$checkErrorFlag| margin w verbatim u2 okBefore u) + (declare (special |$checkErrorFlag| |$argl| |$checkingXmptex?|)) + (setq |$checkErrorFlag| t) + (setq margin 0) + (setq lines (|checkRemoveComments| lines)) + (setq u lines) + (when |$checkingXmptex?| + (setq u + (loop for x in u + collect (|checkAddIndented| x margin)))) + (setq |$argl| (|checkGetArgs| (car u))) + (setq u2 nil) + (setq verbatim nil) + (loop for x in u + do + (setq w (|newString2Words| x)) + (cond + (verbatim + (cond + ((and w (equal (car w) "\\end{verbatim}")) + (setq verbatim nil) + (setq u2 (append u2 w))) + (t + (setq u2 (append u2 (list x)))))) + ((and w (equal (car w) "\\begin{verbatim}")) + (setq verbatim t) + (setq u2 (append u2 w))) + (t (setq u2 (append u2 w))))) + (setq u u2) + (setq u (|checkAddSpaces| u)) + (setq u (|checkSplit2Words| u)) + (setq u (|checkAddMacros| u)) + (setq u (|checkTexht| u)) + (setq okBefore (null |$checkErrorFlag|)) + (|checkArguments| u) + (when |$checkErrorFlag| (setq u (|checkFixCommonProblem| u))) + (|checkRecordHash| u) + (|checkDecorateForHt| u))) + +\end{chunk} + \defun{checkDocError1}{checkDocError1} \calls{checkDocError1}{checkDocError} \refsdollar{checkDocError1}{compileDocumentation} @@ -19672,6 +19732,26 @@ deleting entries from u assumes that the first element is useless \end{chunk} +\defun{checkArguments}{checkArguments} +\calls{checkArguments}{hget} +\calls{checkArguments}{checkHTargs} +\refsdollar{checkArguments}{htMacroTable} +\begin{chunk}{defun checkArguments} +(defun |checkArguments| (u) + (let (x k) + (declare (special |$htMacroTable|)) + (loop while u + do (setq x (car u)) + (cond + ((null (setq k (hget |$htMacroTable| x))) '|skip|) + ((eql k 0) '|skip|) + ((> k 0) (|checkHTargs| x (cdr u) k nil)) + (t (|checkHTargs| x (cdr u) -k t))) + (pop u)) + u)) + +\end{chunk} + \defun{checkTransformFirsts}{checkTransformFirsts} \calls{checkTransformFirsts}{pname} \calls{checkTransformFirsts}{leftTrim} @@ -19804,6 +19884,66 @@ deleting entries from u assumes that the first element is useless \end{chunk} +\defun{checkSkipBlanks}{checkSkipBlanks} +\refsdollar{checkSkipBlanks}{charBlank} +\begin{chunk}{defun checkSkipBlanks} +(defun |checkSkipBlanks| (u i m) + (declare (special |$charBlank|)) + (do () + ((null (and (> m i) (equal (elt u i) |$charBlank|))) nil) + (setq i (1+ i))) + (unless (= i m) i)) + +\end{chunk} + +\defun{checkSkipIdentifierToken}{checkSkipIdentifierToken} +\calls{checkSkipIdentifierToken}{checkAlphabetic} +\begin{chunk}{defun checkSkipIdentifierToken} +(defun |checkSkipIdentifierToken| (u i m) + (do () + ((null (and (> m i) (|checkAlphabetic| (elt u i)))) nil) + (setq i (1+ i))) + (unless (= i m) i)) + +\end{chunk} + +\defun{checkAlphabetic}{checkAlphabetic} +\refsdollar{checkAlphabetic}{charIdentifierEndings} +\begin{chunk}{defun checkAlphabetic} +(defun |checkAlphabetic| (c) + (declare (special |$charIdentifierEndings|)) + (or (alpha-char-p c) (digitp c) (member c |$charIdentifierEndings|))) + +\end{chunk} + +\defun{checkSkipToken}{checkSkipToken} +\calls{checkSkipToken}{checkSkipIdentifierToken} +\calls{checkSkipToken}{checkSkipOpToken} +\begin{chunk}{defun checkSkipToken} +(defun |checkSkipToken| (u i m) + (if (alpha-char-p (elt u i)) + (|checkSkipIdentifierToken| u i m) + (|checkSkipOpToken| u i m))) + +\end{chunk} + +\defun{checkSkipOpToken}{checkSkipOpToken} +\calls{checkSkipOpToken}{checkAlphabetic} +\calls{checkSkipOpToken}{member} +\refsdollar{checkSkipOpToken}{charDelimiters} +\begin{chunk}{defun checkSkipOpToken} +(defun |checkSkipOpToken| (u i m) + (declare (special |$charDelimiters|)) + (do () + ((null (and (> m i) + (null (|checkAlphabetic| (elt u i))) + (null (|member| (elt u i) |$charDelimiters|)))) + nil) + (setq i (1+ i))) + (unless (= i m) i)) + +\end{chunk} + \defun{getMatchingRightPren}{getMatchingRightPren} \calls{getMatchingRightPren}{maxindex} \begin{chunk}{defun getMatchingRightPren} @@ -23863,7 +24003,9 @@ The current input line. \getchunk{defun canReturn} \getchunk{defun char-eq} \getchunk{defun char-ne} +\getchunk{defun checkAlphabetic} \getchunk{defun checkAndDeclare} +\getchunk{defun checkArguments} \getchunk{defun checkComments} \getchunk{defun checkDocError} \getchunk{defun checkDocError1} @@ -23872,6 +24014,11 @@ The current input line. \getchunk{defun checkGetMargin} \getchunk{defun checkIeEg} \getchunk{defun checkIeEgfun} +\getchunk{defun checkRewrite} +\getchunk{defun checkSkipBlanks} +\getchunk{defun checkSkipIdentifierToken} +\getchunk{defun checkSkipOpToken} +\getchunk{defun checkSkipToken} \getchunk{defun checkTransformFirsts} \getchunk{defun checkWarning} \getchunk{defun coerce} diff --git a/changelog b/changelog index 9dd21db..5d04a1e 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20111117 wxh src/axiom-website/patches.html 20111117.01.tpd.patch +20111117 tpd src/interp/c-doc.lisp treeshake compiler +20111117 tpd books/bookvol9 treeshake compiler 20111116 wxh src/axiom-website/patches.html 20111116.02.wxh.patch 20111116 wxh src/interp/i-spec2.lisp fix AN has sqrt: % -> % 20111116 tpd src/axiom-website/patches.html 20111116.01.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 697b44d..fef254b 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3684,5 +3684,7 @@ books/bookvol9 treeshake compiler, remove apply.lisp
books/bookvol9 treeshake compiler
20111116.02.wxh.patch src/interp/i-spec2.lisp fix AN has sqrt: % -> %
+20111117.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/c-doc.lisp.pamphlet b/src/interp/c-doc.lisp.pamphlet index d2fe917..fd7ec11 100644 --- a/src/interp/c-doc.lisp.pamphlet +++ b/src/interp/c-doc.lisp.pamphlet @@ -229,108 +229,6 @@ G166663) (SEQ (EXIT (SETQ G166663 (STRCONC G166663 |x|)))))))))))) -;checkRewrite(name,lines) == main where --similar to checkComments from c-doc -; main == -; $checkErrorFlag: local := true -; margin := 0 -; lines := checkRemoveComments lines -; u := lines -; if $checkingXmptex? then -; u := [checkAddIndented(x,margin) for x in u] -; $argl := checkGetArgs first u --set $argl -; u2 := nil -; verbatim := nil -; for x in u repeat -; w := newString2Words x -; verbatim => -; w and first w = '"\end{verbatim}" => -; verbatim := false -; u2 := append(u2, w) -; u2 := append(u2, [x]) -; w and first w = '"\begin{verbatim}" => -; verbatim := true -; u2 := append(u2, w) -; u2 := append(u2, w) -; u := u2 -; u := checkAddSpaces u -; u := checkSplit2Words u -; u := checkAddMacros u -; u := checkTexht u -;-- checkBalance u -; okBefore := null $checkErrorFlag -; checkArguments u -; if $checkErrorFlag then u := checkFixCommonProblem u -; checkRecordHash u -;-- u := checkTranVerbatim u -; checkDecorateForHt u - -(DEFUN |checkRewrite| (|name| |lines|) - (PROG (|$checkErrorFlag| |margin| |w| |verbatim| |u2| |okBefore| |u|) - (DECLARE (SPECIAL |$checkErrorFlag| |$argl| |$checkingXmptex?|)) - (RETURN - (SEQ (PROGN - (SPADLET |$checkErrorFlag| 'T) - (SPADLET |margin| 0) - (SPADLET |lines| (|checkRemoveComments| |lines|)) - (SPADLET |u| |lines|) - (COND - (|$checkingXmptex?| - (SPADLET |u| - (PROG (G166716) - (SPADLET G166716 NIL) - (RETURN - (DO ((G166721 |u| (CDR G166721)) - (|x| NIL)) - ((OR (ATOM G166721) - (PROGN - (SETQ |x| (CAR G166721)) - NIL)) - (NREVERSE0 G166716)) - (SEQ (EXIT - (SETQ G166716 - (CONS - (|checkAddIndented| |x| - |margin|) - G166716)))))))))) - (SPADLET |$argl| (|checkGetArgs| (CAR |u|))) - (SPADLET |u2| NIL) - (SPADLET |verbatim| NIL) - (DO ((G166732 |u| (CDR G166732)) (|x| NIL)) - ((OR (ATOM G166732) - (PROGN (SETQ |x| (CAR G166732)) NIL)) - NIL) - (SEQ (EXIT (PROGN - (SPADLET |w| (|newString2Words| |x|)) - (COND - (|verbatim| - (COND - ((AND |w| - (BOOT-EQUAL (CAR |w|) - "\\end{verbatim}")) - (SPADLET |verbatim| NIL) - (SPADLET |u2| (APPEND |u2| |w|))) - ('T - (SPADLET |u2| - (APPEND |u2| (CONS |x| NIL)))))) - ((AND |w| - (BOOT-EQUAL (CAR |w|) - "\\begin{verbatim}")) - (SPADLET |verbatim| 'T) - (SPADLET |u2| (APPEND |u2| |w|))) - ('T (SPADLET |u2| (APPEND |u2| |w|)))))))) - (SPADLET |u| |u2|) - (SPADLET |u| (|checkAddSpaces| |u|)) - (SPADLET |u| (|checkSplit2Words| |u|)) - (SPADLET |u| (|checkAddMacros| |u|)) - (SPADLET |u| (|checkTexht| |u|)) - (SPADLET |okBefore| (NULL |$checkErrorFlag|)) - (|checkArguments| |u|) - (COND - (|$checkErrorFlag| - (SPADLET |u| (|checkFixCommonProblem| |u|)))) - (|checkRecordHash| |u|) - (|checkDecorateForHt| |u|)))))) - ;checkTexht u == ; count := 0 ; acc := nil @@ -2597,41 +2495,6 @@ (CONS "}" NIL))))) ('T '|ok|))))))) -;checkArguments u == -; while u repeat -; do -; x := first u -; null (k := HGET($htMacroTable,x)) => 'skip -; k = 0 => 'skip -; k > 0 => checkHTargs(x,rest u,k,nil) -; checkHTargs(x,rest u,-k,true) -; u := rest u -; u - -(DEFUN |checkArguments| (|u|) - (PROG (|x| |k|) - (declare (special |$htMacroTable|)) - (RETURN - (SEQ (PROGN - (DO () ((NULL |u|) NIL) - (SEQ (EXIT (PROGN - (|do| (PROGN - (SPADLET |x| (CAR |u|)) - (COND - ((NULL - (SPADLET |k| - (HGET |$htMacroTable| |x|))) - '|skip|) - ((EQL |k| 0) '|skip|) - ((> |k| 0) - (|checkHTargs| |x| (CDR |u|) |k| - NIL)) - ('T - (|checkHTargs| |x| (CDR |u|) - (SPADDIFFERENCE |k|) 'T))))) - (SPADLET |u| (CDR |u|)))))) - |u|))))) - ;checkHTargs(keyword,u,nargs,integerValue?) == ;--u should start with an open brace ... ; nargs = 0 => 'ok @@ -2743,71 +2606,6 @@ (AND G167927 (DIGIT-CHAR-P (ELT |s| |i|))))))))))))))) -;checkSkipBlanks(u,i,m) == -; while i < m and u.i = $charBlank repeat i := i + 1 -; i = m => nil -; i - -(DEFUN |checkSkipBlanks| (|u| |i| |m|) - (declare (special |$charBlank|)) - (SEQ (PROGN - (DO () - ((NULL (AND (> |m| |i|) - (BOOT-EQUAL (ELT |u| |i|) |$charBlank|))) - NIL) - (SEQ (EXIT (SPADLET |i| (PLUS |i| 1))))) - (COND ((BOOT-EQUAL |i| |m|) NIL) ('T |i|))))) - -;checkSkipToken(u,i,m) == -; ALPHA_-CHAR_-P(u.i) => checkSkipIdentifierToken(u,i,m) -; checkSkipOpToken(u,i,m) - -(DEFUN |checkSkipToken| (|u| |i| |m|) - (COND - ((ALPHA-CHAR-P (ELT |u| |i|)) - (|checkSkipIdentifierToken| |u| |i| |m|)) - ('T (|checkSkipOpToken| |u| |i| |m|)))) - -;checkSkipOpToken(u,i,m) == -; while i < m and -; (not(checkAlphabetic(u.i)) and not(MEMBER(u.i,$charDelimiters))) repeat -; i := i + 1 -; i = m => nil -; i - -(DEFUN |checkSkipOpToken| (|u| |i| |m|) - (declare (special |$charDelimiters|)) - (SEQ (PROGN - (DO () - ((NULL (AND (> |m| |i|) - (NULL (|checkAlphabetic| (ELT |u| |i|))) - (NULL (|member| (ELT |u| |i|) - |$charDelimiters|)))) - NIL) - (SEQ (EXIT (SPADLET |i| (PLUS |i| 1))))) - (COND ((BOOT-EQUAL |i| |m|) NIL) ('T |i|))))) - -;checkSkipIdentifierToken(u,i,m) == -; while i < m and checkAlphabetic u.i repeat i := i + 1 -; i = m => nil -; i - -(DEFUN |checkSkipIdentifierToken| (|u| |i| |m|) - (SEQ (PROGN - (DO () - ((NULL (AND (> |m| |i|) (|checkAlphabetic| (ELT |u| |i|)))) - NIL) - (SEQ (EXIT (SPADLET |i| (PLUS |i| 1))))) - (COND ((BOOT-EQUAL |i| |m|) NIL) ('T |i|))))) - -;checkAlphabetic c == -; ALPHA_-CHAR_-P c or DIGITP c or MEMQ(c,$charIdentifierEndings) - -(DEFUN |checkAlphabetic| (|c|) - (declare (special |$charIdentifierEndings|)) - (OR (ALPHA-CHAR-P |c|) (DIGITP |c|) - (member |c| |$charIdentifierEndings|))) - ;--======================================================================= ;-- Code for creating a personalized report for ++ comments ;--======================================================================= @@ -2887,58 +2685,6 @@ ;--======================================================================= ;-- Report Documentation Error ;--======================================================================= -;checkDocError1 u == -;--when compiling for documentation, ignore certain errors -; BOUNDP '$compileDocumentation and $compileDocumentation => nil -; checkDocError u - -(DEFUN |checkDocError1| (|u|) - (declare (special |$compileDocumentation|)) - (COND - ((AND (BOUNDP '|$compileDocumentation|) |$compileDocumentation|) - NIL) - ('T (|checkDocError| |u|)))) - -;checkDocError u == -; $checkErrorFlag := true -; msg := -; $recheckingFlag => -; $constructorName => checkDocMessage u -; concat('"> ",u) -; $constructorName => checkDocMessage u -; u -; if $exposeFlag and $exposeFlagHeading then -; SAYBRIGHTLY1($exposeFlagHeading,$outStream) -; sayBrightly $exposeFlagHeading -; $exposeFlagHeading := nil -; sayBrightly msg -; if $exposeFlag then SAYBRIGHTLY1(msg,$outStream) - -(DEFUN |checkDocError| (|u|) - (PROG (|msg|) - (declare (special |$outStream| |$exposeFlag| |$exposeFlagHeading| - |$constructorName| |$recheckingFlag| |$checkErrorFlag|)) - (RETURN - (PROGN - (SPADLET |$checkErrorFlag| 'T) - (SPADLET |msg| - (COND - (|$recheckingFlag| - (COND - (|$constructorName| (|checkDocMessage| |u|)) - ('T (|concat| "> " |u|)))) - (|$constructorName| (|checkDocMessage| |u|)) - ('T |u|))) - (COND - ((AND |$exposeFlag| |$exposeFlagHeading|) - (SAYBRIGHTLY1 |$exposeFlagHeading| |$outStream|) - (|sayBrightly| |$exposeFlagHeading|) - (SPADLET |$exposeFlagHeading| NIL))) - (|sayBrightly| |msg|) - (COND - (|$exposeFlag| (SAYBRIGHTLY1 |msg| |$outStream|)) - ('T NIL)))))) - ;checkDecorateForHt u == ; count := 0 ; spadflag := false --means OK to wrap single letter words with \s{}