diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 9b319eb..59b112a 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -612,6 +612,7 @@ information is initialized. (|sayKeyedMsg| 'S2GL0018C nil) (|sayKeyedMsg| 'S2GL0018D nil) (|sayKeyedMsg| 'S2GL0003B (list |$opSysName|)) + (say " Visit http://axiom-developer.org for more information") (|sayMSG| bar) (setq |$msgAlist| nil) (|sayMSG| '| |)))) @@ -1640,7 +1641,7 @@ this is what the current code does so I won't change it. ((eq result '|ncEnd|) stepNo) ((eq result '|ncError|) stepNo) ((eq result '|ncEndItem|) stepNo) - (t (+ stepNo 1))))) + (t (1+ stepNo))))) @ @@ -1713,6 +1714,7 @@ carrier[lines,messages,..]-> carrier[lines,messages,..] \usesdollar{phIntReportMsgs}{erMsgToss} <>= (defun |phIntReportMsgs| (carrier interactive?) + (declare (ignore interactive?)) (let (nerr msgs lines) (declare (special |$erMsgToss|)) (cond @@ -2650,7 +2652,7 @@ contiguous comment spanning enough lines to overflow the stack. ((or (atom Var7) (progn (setq n (car Var7)) nil)) (return (nreverse Var8))) (t - (setq Var8 (cons (|porigin| n) Var)))) + (setq Var8 (cons (|porigin| n) Var8)))) (setq Var7 (cdr Var7)))) nil (reverse ufos) nil)) (setq f1 (|porigin| fn)) @@ -2865,6 +2867,7 @@ b ==> 7 @ + \defun{incClassify}{incClassify} \begin{verbatim} ;incClassify(s) == @@ -2881,44 +2884,48 @@ b ==> 7 ; if bad then [true,0,'"other"] else [true,eb,p1] \end{verbatim} \calls{incClassify}{incCommand?} +\uses{incClassify}{incCommands} <>= -(defun |incClassify| (|s|) - (let (|p1| |bad| |eb| |n| |i|) - (cond - ((null (|incCommand?| |s|)) (list nil 0 "")) - (t - (setq |i| 1) - (setq |n| (length |s|)) +(defun |incClassify| (s) + (let (p1 bad eb n i) + (declare (special |incCommands|)) + (if (null (|incCommand?| s)) + (list nil 0 "") + (progn + (setq i 1) + (setq n (length s)) ((lambda () (loop (cond - ((not (and (< |i| |n|) (equal (ELT |s| |i|) (|char| '| |)))) + ((not (and (< i n) (char= (elt s i) #\space))) (return nil)) - (t (setq |i| (+ |i| 1))))))) + (t (setq i (1+ i))))))) (cond - ((not (< |i| |n|)) (list T 0 "other")) + ((not (< i n)) (list t 0 "other")) (t - (setq |eb| (cond ((eql |i| 1) 0) (t |i|))) - (setq |bad| t) - ((lambda (|bfVar#2| |p|) + (if (= i 1) + (setq eb 0) + (setq eb i)) + (setq bad t) + ((lambda (tmp1 p) (loop (cond - ((or (atom |bfVar#2|) - (progn (setq |p| (car |bfVar#2|)) nil) - (not |bad|)) + ((or (atom tmp1) + (progn (setq p (car tmp1)) nil) + (not bad)) (return nil)) (t (cond - ((|incPrefix?| |p| |i| |s|) + ((|incPrefix?| p i s) (identity (progn - (setq |bad| nil) - (setq |p1| |p|))))))) - (setq |bfVar#2| (cdr |bfVar#2|)))) + (setq bad nil) + (setq p1 p))))))) + (setq tmp1 (cdr tmp1)))) |incCommands| nil) - (cond - (|bad| (list t 0 "other")) - (t (list t |eb| |p1|))))))))) + (if bad + (list t 0 "other") + (list t eb p1)))))))) @ @@ -3895,14 +3902,16 @@ To pair badge and badgee \defvar{scanCloser} <>= (eval-when (eval load) - (setq |scanCloser| (list '|)| '} '] '|\|)| '|\|}| '|\|]|))) + (defvar |scanCloser| (list '|)| '} '] '|\|)| '|\|}| '|\|]|))) @ \defun{scanCloser?}{scanCloser?} \calls{scanCloser?}{memq} \calls{scanCloser?}{keyword} +\uses{scanCloser?}{scanCloser} <>= (defun |scanCloser?| (w) + (declare (special |scanCloser|)) (memq (|keyword| w) |scanCloser|)) @ @@ -6043,18 +6052,20 @@ org prints out the word noposition or console @ \defun{setMsgCatlessAttr}{setMsgCatlessAttr} +\tpdhere{Changed from |catless| to '|catless|} \calls{setMsgCatlessAttr}{ncPutQ} \calls{setMsgCatlessAttr}{ifcdr} \calls{setMsgCatlessAttr}{qassq} \calls{setMsgCatlessAttr}{ncAlist} <>= (defun |setMsgCatlessAttr| (msg attr) - (|ncPutQ| msg |catless| ; probably should be '|catless|? -- TPDHERE + (|ncPutQ| msg '|catless| (cons attr (ifcdr (qassq |catless| (|ncAlist| msg)))))) @ \defun{putDatabaseStuff}{putDatabaseStuff} +\tpdhere{The variable al is undefined} \calls{putDatabaseStuff}{getMsgInfoFromKey} \calls{putDatabaseStuff}{setMsgUnforcedAttrList} \calls{putDatabaseStuff}{setMsgText} @@ -6300,14 +6311,14 @@ Bug in the compiler: something which shouldn't have happened did. \usesdollar{makeMsgFromLine}{preLength} <>= (defun |makeMsgFromLine| (line) - (let (localNumOfLine stNum i globalNumOfLine textOfLine posOfLine) + (let (localNumOfLine stNum globalNumOfLine textOfLine posOfLine) (declare (special |$preLength|)) (setq posOfLine (|getLinePos| line)) (setq textOfLine (|getLineText| line)) (setq globalNumOfLine (|poGlobalLinePosn| posOfLine)) (setq stNum (stringimage (|poLinePosn| posOfLine))) (setq localNumOfLine - (strconc (|rep| (|char| '| |) (- |$preLength| 7 (size stNum))) stNum)) + (strconc (|rep| #\space (- |$preLength| 7 (size stNum))) stNum)) (list '|line| posOfLine nil nil (strconc "Line" localNumOfLine) textOfLine))) @ @@ -6560,6 +6571,7 @@ makeLeaderMsg chPosList == @ \defun{posPointers}{posPointers} +\tpdhere{getMsgFTTag is nonsense} \calls{posPointers}{poCharPosn} \calls{posPointers}{getMsgPos} \calls{posPointers}{IFCAR} @@ -6575,8 +6587,8 @@ makeLeaderMsg chPosList == (unless (equal pos (ifcar posList)) (setq posList (cons pos posList))) ; this should probably read TPDHERE - ; (when (eq (getMsgPosTagOb| msg) 'fromto) - (when (eq getMsgFTTag 'fromto) + ; (when (eq (|getMsgPosTagOb| msg) 'fromto) + (when (eq |getMsgFTTag| 'fromto) (setq ftPosList (cons (|poCharPosn| (|getMsgPos2| msg)) ftPosList)))) (dolist (toPos ftPosList) (setq posList (|insertPos| toPos posList))) @@ -8400,7 +8412,7 @@ new system commands provided you handle the argument parsing. \calls{handleTokensizeSystemCommands}{systemCommand} <>= (defun |handleTokensizeSystemCommands| (unabr optionList) - (declare (ignore ubabr)) + (declare (ignore unabr)) (let (parcmd) (setq optionList (mapcar #'(lambda (x) (|dumbTokenize| x)) optionList)) (setq parcmd @@ -8884,14 +8896,13 @@ The \verb|$msgdbPrims| variable is set to: (equal (|objMode| u) |$EmptyMode|)) (|displayRule| |$op| expr) (progn - (setq |label| (cond - (|omitVariableNameIfTrue| - (setq |rhs| "): ") - "Value (has type ") - ('T - (setq |rhs| ": ") - (strconc "Value of " (pname |$op|) ": ")))) + (omitVariableNameIfTrue + (setq rhs "): ") + (setq label "Value (has type ")) + (t + (setq rhs ": ") + (setq label (strconc "Value of " (pname |$op|) ": ")))) (setq labmode (|prefix2String| (|objMode| u))) (when (atom labmode) (setq labmode (list labmode))) (if (eq (getdatabase expr 'constructorkind) '|domain|) @@ -9161,7 +9172,7 @@ The \verb|$msgdbPrims| variable is set to: (spadlet prefix (cons '| Compiled function type| (append varPart (cons '|: | nil)))) (|sayBrightly| (|concat| prefix (|formatSignature| signature)))))) - (mapcar #'(lambda (mm) (g v mm giveVariableIfNil)) val))) + (mapcar #'(lambda (x) (g v x giveVariableIfNil)) val))) @ @@ -9487,7 +9498,7 @@ The prefix goes before each element on each side of the list, eg, ")" (|sayMessage| `(,label1 "-defined " ,label2 " satisfying patterns:" |%l| " " |%b| ,@(append (|blankList| patterns) (list '|%d|))))) - (do ((t1 ls (cdr t1)) (t2 nil)) + (do ((t1 ls (cdr t1))) ((atom t1) nil) (setq syn (caar t1)) (setq comm (cdar t1)) @@ -21129,7 +21140,7 @@ o )what <>= (defun |reportOpsFromLisplib| (op u) (let (fn s typ nArgs argList functorForm argml tmp1 functorFormWithDecl - verb sourceFile opt x attList) + verb sourceFile opt attList) (declare (special $linelength |$showOptions| |$options| |$FormalMapVariableList|)) (if (null (setq fn (|constructor?| op))) @@ -21267,7 +21278,7 @@ o )what <>= (defun |reportOpsFromUnitDirectly| (unitForm) (let (|$commentedOps| isRecordOrUnion unit top kind abb sourceFile verb opt - x attList constructorFunction tmp1 funlist a b c sigList tmp2) + attList constructorFunction tmp1 funlist a sigList tmp2) (declare (special |$commentedOps| |$CategoryFrame| $linelength |$options| |$showOptions|)) (setq isRecordOrUnion diff --git a/changelog b/changelog index 0c609a5..c389367 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20091231 tpd src/axiom-website/patches.html 20091231.02.tpd.patch +20091231 tpd src/interp/i-syscmd.lisp remove dead code +20091231 tpd books/bookvol5 add banner and cleanup globals 20091231 tpd src/axiom-website/patches.html 20091231.01.tpd.patch 20091231 tpd src/interp/i-syscmd.lisp treeshake 20091231 tpd books/bookvol5 treeshake diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index b170930..97562f1 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2344,5 +2344,7 @@ books/bookvol5 treeshake i-syscmd
books/bookvol5 treeshake i-syscmd
20091231.01.tpd.patch books/bookvol5 treeshake i-syscmd
+20091231.01.tpd.patch +books/bookvol5 add banner and cleanup globals
diff --git a/src/interp/i-syscmd.lisp.pamphlet b/src/interp/i-syscmd.lisp.pamphlet index 60193b2..f340af4 100644 --- a/src/interp/i-syscmd.lisp.pamphlet +++ b/src/interp/i-syscmd.lisp.pamphlet @@ -223,85 +223,6 @@ (CONS (|fillerSpaces| 29 (MAKESTRING ".")) (CONS '| | (CONS |$streamCount| NIL)))))))))) -;whatCommands(patterns) == -; label := STRCONC("System Commands for User Level: ", -; STRINGIMAGE $UserLevel) -; centerAndHighlight(label,$LINELENGTH,specialChar 'hbar) -; l := filterListOfStrings(patterns, -; [(STRINGIMAGE a) for a in commandsForUserLevel $systemCommands]) -; if patterns then -; null l => -; sayMessage ['"No system commands at this level matching patterns:", -; '%l,'" ",'%b,:blankList patterns,'%d] -; sayMessage ['"System commands at this level matching patterns:", -; '%l,'" ",'%b,:blankList patterns,'%d] -; if l then -; sayAsManyPerLineAsPossible l -; SAY " " -; patterns => nil -- don't be so verbose -; sayKeyedMsg("S2IZ0046",NIL) -; nil - -;; (DEFUN |whatCommands| (|patterns|) -;; (PROG (|label| |l|) -;; (declare (special |$systemCommands| $LINELENGTH |$UserLevel|)) -;; (RETURN -;; (SEQ (PROGN -;; (SPADLET |label| -;; (STRCONC '|System Commands for User Level: | -;; (STRINGIMAGE |$UserLevel|))) -;; (|centerAndHighlight| |label| $LINELENGTH -;; (|specialChar| '|hbar|)) -;; (SPADLET |l| -;; (|filterListOfStrings| |patterns| -;; (PROG (G167084) -;; (SPADLET G167084 NIL) -;; (RETURN -;; (DO ((G167089 -;; (|commandsForUserLevel| -;; |$systemCommands|) -;; (CDR G167089)) -;; (|a| NIL)) -;; ((OR (ATOM G167089) -;; (PROGN -;; (SETQ |a| (CAR G167089)) -;; NIL)) -;; (NREVERSE0 G167084)) -;; (SEQ (EXIT -;; (SETQ G167084 -;; (CONS (STRINGIMAGE |a|) -;; G167084))))))))) -;; (COND -;; (|patterns| -;; (COND -;; ((NULL |l|) -;; (|sayMessage| -;; (CONS (MAKESTRING -;; "No system commands at this level matching patterns:") -;; (CONS '|%l| -;; (CONS (MAKESTRING " ") -;; (CONS '|%b| -;; (APPEND -;; (|blankList| |patterns|) -;; (CONS '|%d| NIL)))))))) -;; ('T -;; (|sayMessage| -;; (CONS (MAKESTRING -;; "System commands at this level matching patterns:") -;; (CONS '|%l| -;; (CONS (MAKESTRING " ") -;; (CONS '|%b| -;; (APPEND -;; (|blankList| |patterns|) -;; (CONS '|%d| NIL))))))))))) -;; (COND -;; (|l| (|sayAsManyPerLineAsPossible| |l|) -;; (SAY (MAKESTRING " ")))) -;; (COND -;; (|patterns| NIL) -;; ('T (|sayKeyedMsg| 'S2IZ0046 NIL) NIL))))))) - - ;reportWhatOptions() == ; optList1:= "append"/[['%l,'" ",x] for x in $whatOptions] ; sayBrightly