diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 3f8e692..4f0bfbf 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -1023,7 +1023,7 @@ will end up as a recursive call to ourselves. \uses{processSynonyms}{line} <>= (defun |processSynonyms| () - (let (fill p aline synstr syn to opt fun cl) + (let (fill p aline synstr syn to opt fun cl chr) (declare (special |$CommandSynonymAlist| line)) (setq p (strpos ")" line 0 nil)) (setq fill "") @@ -3416,6 +3416,7 @@ returning the token-dq and the rest of the line-stream \calls{constoken}{ncPutQ} <>= (defun |constoken| (ln lp b n) + (declare (ignore ln)) (let (a) (setq a (cons (elt b 0) (elt b 1))) (|ncPutQ| a '|posn| (cons lp n)) @@ -8303,6 +8304,240 @@ require an argument name themselves, those which do have their names prefixed by ``np''. This makes it possible to dynamically define new system commands provided you handle the argument parsing. +\defun{doSystemCommand}{Handle a top level command} +\calls{doSystemCommand}{concat} +\calls{doSystemCommand}{expand-tabs} +\calls{doSystemCommand}{processSynonyms} +\calls{doSystemCommand}{substring} +\calls{doSystemCommand}{getFirstWord} +\calls{doSystemCommand}{unAbbreviateKeyword} +\calls{doSystemCommand}{member} +\calls{doSystemCommand}{handleNoParseCommands} +\calls{doSystemCommand}{splitIntoOptionBlocks} +\calls{doSystemCommand}{handleTokensizeSystemCommands} +\calls{doSystemCommand}{handleParsedSystemCommands} +\usesdollar{doSystemCommand}{tokenCommands} +\usesdollar{doSystemCommand}{noParseCommands} +\uses{doSystemCommand}{line} +<>= +(defun |doSystemCommand| (string) + (let (line tok unab optionList) + (declare (special line |$tokenCommands| |$noParseCommands|)) + (setq string (concat ")" (expand-tabs string))) + (setq line string) + (|processSynonyms|) + (setq string line) + (setq string (substring string 1 nil)) + (cond + ((string= string "") nil) + (t + (setq tok (|getFirstWord| string)) + (cond + (tok + (setq unab (|unAbbreviateKeyword| tok)) + (cond + ((|member| unab |$noParseCommands|) + (|handleNoParseCommands| unab string)) + (t + (setq optionList (|splitIntoOptionBlocks| string)) + (cond + ((|member| unab |$tokenCommands|) + (|handleTokensizeSystemCommands| unab optionList)) + (t + (|handleParsedSystemCommands| unab optionList) + nil))))) + (t nil)))))) + +@ + +\defun{splitIntoOptionBlocks}{Split block into option block} +\calls{splitIntoOptionBlocks}{stripSpaces} +<>= +(defun |splitIntoOptionBlocks| (str) + (let (optionBlocks inString block (blockStart 0) (parenCount 0) blockList) + (dotimes (i (1- (|#| str))) + (cond + ((char= (elt str i) #\" ) (setq inString (null inString))) + (t + (when (and (char= (elt str i) #\( ) (null inString)) + (incf parenCount)) + (when (and (char= (elt str i) #\) ) (null inString)) + (decf parenCount)) + (when + (and (char= (elt str i) #\) ) + (null inString) + (= parenCount -1)) + (setq block (|stripSpaces| (subseq str blockStart i))) + (setq blockList (cons block blockList)) + (setq blockStart (1+ i)) + (setq parenCount 0))))) + (setq blockList (cons (|stripSpaces| (subseq str blockStart)) blockList)) + (nreverse blockList))) + +@ + +\defun{handleTokensizeSystemCommands}{Tokenize a system command} +\calls{handleTokensizeSystemCommands}{dumbTokenize} +\calls{handleTokensizeSystemCommands}{tokTran} +\calls{handleTokensizeSystemCommands}{systemCommand} +<>= +(defun |handleTokensizeSystemCommands| (unabr optionList) + (declare (ignore ubabr)) + (let (parcmd) + (setq optionList (mapcar #'(lambda (x) (|dumbTokenize| x)) optionList)) + (setq parcmd + (mapcar #'(lambda (opt) (mapcar #'(lambda (tok) (|tokTran| tok)) opt)) + optionLIst)) + (when parcmd (|systemCommand| parcmd)))) + +@ + +\defun{systemCommand}{} +You can type ``)?'' and see trivial help information. +You can type ``)? compiler'' and see compiler related information +\calls{systemCommand}{} +\usesdollar{systemCommand}{options} +\usesdollar{systemCommand}{e} +\usesdollar{systemCommand}{systemCommands} +\usesdollar{systemCommand}{syscommands} +\usesdollar{systemCommand}{CategoryFrame} +<>= +(defun |systemCommand| (cmd) + (let (|$options| |$e| |op| |argl| |options| |fun|) + (declare (special |$options| |$e| |$systemCommands| $syscommands + |$CategoryFrame|)) + (setq |op| (caar cmd)) + (setq |argl| (cdar cmd)) + (setq |options| (cdr cmd)) + (setq |$options| |options|) + (setq |$e| |$CategoryFrame|) + (setq |fun| (|selectOptionLC| |op| $syscommands '|commandError|)) + (if (and |argl| (eq (elt |argl| 0) '?) (nequal |fun| '|synonym|)) + (|helpSpad2Cmd| (cons |fun| nil)) + (progn + (setq |fun| + (|selectOption| |fun| (|commandsForUserLevel| |$systemCommands|) + '|commandUserLevelError|)) + (funcall |fun| |argl|))))) + +@ + +\defun{dumbTokenize}{Split into tokens delimted by spaces} +\calls{dumbTokenize}{stripSpaces} +<>= +(defun |dumbTokenize| (str) + (let (inString token (tokenStart 0) previousSpace tokenList) + (dotimes (i (1- (|#| str))) + (cond + ((char= (elt str i) #\") ; don't split strings + (setq inString (null inString)) + (setq previousSpace nil)) + ((and (char= (elt str i) #\space) (null inString)) + (unless previousSpace + (setq token (|stripSpaces| (subseq str tokenStart i))) + (setq tokenList (cons token tokenList)) + (setq tokenStart (1+ i)) + (setq previousSpace t))) + (t + (setq previousSpace nil)))) + (setq tokenList (cons (|stripSpaces| (subseq str tokenStart)) tokenList)) + (nreverse tokenList))) + +@ + +\defun{tokTran}{Convert string tokens to their proper type} +\calls{tokTran}{isIntegerString} +<>= +(defun |tokTran| (tok) + (let (tmp) + (if (stringp tok) + (cond + ((eql (|#| tok) 0) nil) + ((setq tmp (|isIntegerString| tok)) tmp) + ((char= (elt tok 0) #\" ) (subseq tok 1 (1- (|#| tok)))) + (t (intern tok))) + tok))) + +@ + +\defun{isIntegerString}{Is the argument string an integer?} +<>= +(defun |isIntegerString| (tok) + (multiple-value-bind (int len) (parse-integer tok :junk-allowed t) + (when (and int (= len (length tok))) int))) + +@ + +\defun{handleParsedSystemCommands}{Handle parsed system commands} +\calls{handleParsedSystemCommands}{dumbTokenize} +\calls{handleParsedSystemCommands}{parseSystemCmd} +\calls{handleParsedSystemCommands}{tokTran} +\calls{handleParsedSystemCommands}{systemCommand} +<>= +(defun |handleParsedSystemCommands| (unabr optionList) + (declare (ingore unabr)) + (let (restOptionList parcmd trail) + (setq restOptionList (mapcar #'|dumbTokenize| (cdr optionList))) + (setq parcmd (|parseSystemCmd| (car optionList))) + (setq trail + (mapcar #'(lambda (opt) + (mapcar #'(lambda (tok) (|tokTran| tok)) opt)) restOptionList)) + (|systemCommand| (list parcmd trail))))) + +@ + +\defun{parseSystemCmd}{Parse a system command} +\calls{parseSystemCmd}{tokTran} +\calls{parseSystemCmd}{stripSpaces} +\calls{parseSystemCmd}{parseFromString} +\calls{parseSystemCmd}{dumbTokenize} +<>= +(defun |parseSystemCmd| (opt) + (let (spaceIndex) + (if (setq spaceIndex (search " " opt)) + (list + (|tokTran| (|stripSpaces| (subseq opt 0 spaceIndex))) + (|parseFromString| (|stripSpaces| (subseq opt spaceIndex)))) + (mapcar #'|tokTran| (|dumbTokenize| opt))))) + +@ + +\defun{getFirstWord}{Get first word in a string} +\calls{getFirstWord}{subseq} +\calls{getFirstWord}{stringSpaces} +<>= +(defun |getFirstWord| (string) + (let (spaceIndex) + (setq spaceIndex (search " " string)) + (if spaceIndex + (|stripSpaces| (subseq string 0 spaceIndex)) + string))) + +@ + +\defun{unAbbreviateKeyword}{Unabbreviate keywords in commands} +\calls{unAbbreviateKeyword}{selectOptionLC} +\calls{unAbbreviateKeyword}{selectOption} +\calls{unAbbreviateKeyword}{commandsForUserLevel} +\usesdollar{unAbbreviateKeyword}{systemCommands} +\usesdollar{unAbbreviateKeyword}{currentLine} +\usesdollar{unAbbreviateKeyword}{syscommands} +\uses{unAbbreviateKeyword}{line} +<>= +(defun |unAbbreviateKeyword| (x) + (let (xp) + (declare (special |$systemCommands| |$currentLine| $syscommands line)) + (setq xp (|selectOptionLC| x $syscommands '|commandErrorIfAmbiguous|)) + (cond + ((null xp) + (setq xp '|system|) + (setq line (concat ")system " (substring line 1 (1- (|#| line))))) + (spadlet |$currentLine| line))) + (|selectOption| xp (|commandsForUserLevel| |$systemCommands|) + '|commandUserLevelError|))) + +@ + \calls{handleNoParseCommands}{stripSpaces} \calls{handleNoParseCommands}{nplisp} \calls{handleNoParseCommands}{stripLisp} @@ -8375,6 +8610,7 @@ new system commands provided you handle the argument parsing. \tpdhere{Remove all boot references from top level} <>= (defun |npboot| (str) + (declare (ignore str)) (format t "The )boot command is no longer supported~%")) @ @@ -8403,10 +8639,32 @@ in practice. \calls{npsynonym}{npProcessSynonym} <>= (defun |npsynonym| (unab str) + (declare (ignore unab)) (|npProcessSynonym| str)) @ +\defun{npProcessSynonym}{Handle the synonym system command} +\calls{npProcessSynonym}{printSynonyms} +\calls{npProcessSynonym}{processSynonymLine} +\calls{npProcessSynonym}{putalist} +\calls{npProcessSynonym}{terminateSystemCommand} +\usesdollar{npProcessSynonym}{CommandSynonymAlist} +<>= +(defun |npProcessSynonym| (str) + (let (pair) + (declare (special |$CommandSynonymAlist|)) + (if (= (length str) 0) + (|printSynonyms| nil) + (progn + (setq pair (|processSynonymLine| str)) + (if |$CommandSynonymAlist| + (putalist |$CommandSynonymAlist| (car pair) (cdr pair))) + (setq |$CommandSynonymAlist| (cons pair nil)))) + (|terminateSystemCommand|))) + +@ + \defdollar{tokenCommands} This is a list of the commands that expect the interpreter to parse their arguments. Thus the history command expects that Axiom will have @@ -10438,7 +10696,7 @@ in the Category, Domain, or Package source code. (wrapOneLine spill margin (append (list oneline) result)))))) (reflowParagraph (line) - (let (lst1 lst2) + (let (lst1) (setq lst1 (splitAtNewLine line)) (dolist (x lst1) (mapcar #'(lambda(y) (format t "~a~%" y)) @@ -15596,6 +15854,12 @@ recurrence specially compile recurrence relations on |htSetCache|) @ \section{Variables Used} +\defdollar{cacheAlist} +<>= +(defvar |$cacheAlist| nil) + +@ + \section{Functions} \defunsec{setFunctionsCache}{The top level set functions cache handler} \begin{verbatim} @@ -24042,8 +24306,10 @@ o )library \defun{getParserMacroNames}{getParserMacroNames} The \verb|$pfMacros| is a list of all of the user-defined macros. +\usesdollar{getParserMacroNames}{pfMacros} <>= (defun |getParserMacroNames| () + (declare (special |$pfMacros|)) (remove-duplicates (mapcar #'car |$pfMacros|))) @ @@ -24489,7 +24755,7 @@ The \verb|$msgdbPrims| variable is set to: \uses{/rq}{Echo-Meta} <>= (defun /RQ (&rest foo &aux (Echo-Meta nil)) - (declare (special Echo-Meta)) + (declare (special Echo-Meta) (ignore foo)) (/rf-1 nil)) @ @@ -28034,11 +28300,13 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> <> <> <> +<> <> <> @@ -28089,6 +28357,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> <> @@ -28123,6 +28392,8 @@ See Steele Common Lisp 1990 pp305-307 <> <> +<> +<> <> <> <> @@ -28209,6 +28480,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> <> @@ -28325,6 +28597,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> <> @@ -28338,6 +28611,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> +<> <> <> <> @@ -28544,6 +28818,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> <> @@ -28560,6 +28835,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> @@ -28573,6 +28849,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> <> @@ -28592,6 +28869,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> +<> <> <> <> diff --git a/changelog b/changelog index 3b17710..557ab6e 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20091224 tpd src/axiom-website/patches.html 20091224.01.tpd.patch +20091224 tpd src/interp/i-syscmd.lisp treeshake +20091224 tpd books/bookvol5 treeshake +20091223 tpd src/axiom-website/patches.html 20091223.01.tpd.patch 20091223 tpd src/axiom-website/patches.html 20091223.01.tpd.patch 20091223 tpd src/interp/vmlisp.lisp treeshake 20091223 tpd src/interp/util.lisp treeshake diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 1161ec6..795f9f0 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2332,5 +2332,7 @@ books/bookvol5 merge, remove daase.lisp
books/bookvol5 treeshake .input file reader
20091223.01.tpd.patch books/bookvol5 treeshake
+20091224.01.tpd.patch +books/bookvol5 treeshake
diff --git a/src/interp/i-syscmd.lisp.pamphlet b/src/interp/i-syscmd.lisp.pamphlet index eea7680..6198486 100644 --- a/src/interp/i-syscmd.lisp.pamphlet +++ b/src/interp/i-syscmd.lisp.pamphlet @@ -13,19 +13,6 @@ (IN-PACKAGE "BOOT" ) -;--% Utility Variable Initializations -;SETANDFILEQ($cacheAlist,nil) - -(SETANDFILEQ |$cacheAlist| NIL) - -;SETANDFILEQ($reportCompilation,nil) - -(SETANDFILEQ |$reportCompilation| NIL) - -;SETANDFILEQ($compileRecurrence,true) - -(SETANDFILEQ |$compileRecurrence| (QUOTE T)) - ;SETANDFILEQ($errorReportLevel,'warning) (SETANDFILEQ |$errorReportLevel| (QUOTE |warning|)) @@ -72,30 +59,6 @@ ; 'commandUserLevelError) ; FUNCALL(fun, argl) -(DEFUN |systemCommand| (G166076) - (PROG (|$options| |$e| |op| |argl| |options| |fun|) - (DECLARE (SPECIAL |$options| |$e| |$systemCommands| $SYSCOMMANDS - |$CategoryFrame|)) - (RETURN - (PROGN - (SPADLET |op| (CAAR G166076)) - (SPADLET |argl| (CDAR G166076)) - (SPADLET |options| (CDR G166076)) - (SPADLET |$options| |options|) - (SPADLET |$e| |$CategoryFrame|) - (SPADLET |fun| - (|selectOptionLC| |op| $SYSCOMMANDS '|commandError|)) - (COND - ((AND |argl| (BOOT-EQUAL (ELT |argl| 0) '?) - (NEQUAL |fun| '|synonym|)) - (|helpSpad2Cmd| (CONS |fun| NIL))) - ('T - (SPADLET |fun| - (|selectOption| |fun| - (|commandsForUserLevel| |$systemCommands|) - '|commandUserLevelError|)) - (FUNCALL |fun| |argl|))))))) - ;commandsForUserLevel l == --[a for [a,:b] in l | satisfiesUserLevel(a)] ; c := nil ; for [a,:b] in l repeat @@ -160,33 +123,6 @@ ('T (SPADLET |nl| (CONS |syn| |nl|)))))))) |nl|)))))) -;unAbbreviateKeyword x == -; x' :=selectOptionLC(x,$SYSCOMMANDS,'commandErrorIfAmbiguous) -; if not x' then -; x' := 'system -; SETQ(LINE, CONCAT('")system ", SUBSTRING(LINE, 1, #LINE-1))) -; $currentLine := LINE -; selectOption(x',commandsForUserLevel $systemCommands, -; 'commandUserLevelError) - -(DEFUN |unAbbreviateKeyword| (|x|) - (PROG (|x'|) - (declare (special |$systemCommands| |$currentLine| $SYSCOMMANDS)) - (RETURN - (PROGN - (SPADLET |x'| - (|selectOptionLC| |x| $SYSCOMMANDS - '|commandErrorIfAmbiguous|)) - (COND - ((NULL |x'|) (SPADLET |x'| '|system|) - (SETQ LINE - (CONCAT (MAKESTRING ")system ") - (SUBSTRING LINE 1 - (SPADDIFFERENCE (|#| LINE) 1)))) - (SPADLET |$currentLine| LINE))) - (|selectOption| |x'| (|commandsForUserLevel| |$systemCommands|) - '|commandUserLevelError|))))) - ;commandUserLevelError(x,u) == userLevelErrorMessage("command",x,u) (DEFUN |commandUserLevelError| (|x| |u|) @@ -2018,57 +1954,6 @@ (SUBSTRING |s| (PLUS |k| 1) NIL)))))) ('T |s|)))))) -;doSystemCommand string == -; string := CONCAT('")", EXPAND_-TABS string) -; LINE: fluid := string -; processSynonyms() -; string := LINE -; string:=SUBSTRING(string,1,nil) -; string = '"" => nil -; tok:=getFirstWord(string) -; tok => -; unab := unAbbreviateKeyword tok -; MEMBER(unab, $noParseCommands) => -; handleNoParseCommands(unab, string) -; optionList := splitIntoOptionBlocks string -; MEMBER(unab, $tokenCommands) => -; handleTokensizeSystemCommands(unab, optionList) -; handleParsedSystemCommands(unab, optionList) -; nil -; nil - -(DEFUN |doSystemCommand| (|string|) - (PROG (LINE |tok| |unab| |optionList|) - (DECLARE (SPECIAL LINE |$tokenCommands| |$noParseCommands|)) - (RETURN - (PROGN - (SPADLET |string| - (CONCAT (MAKESTRING ")") (EXPAND-TABS |string|))) - (SPADLET LINE |string|) - (|processSynonyms|) - (SPADLET |string| LINE) - (SPADLET |string| (SUBSTRING |string| 1 NIL)) - (COND - ((BOOT-EQUAL |string| (MAKESTRING "")) NIL) - ('T (SPADLET |tok| (|getFirstWord| |string|)) - (COND - (|tok| (SPADLET |unab| (|unAbbreviateKeyword| |tok|)) - (COND - ((|member| |unab| |$noParseCommands|) - (|handleNoParseCommands| |unab| |string|)) - ('T - (SPADLET |optionList| - (|splitIntoOptionBlocks| |string|)) - (COND - ((|member| |unab| |$tokenCommands|) - (|handleTokensizeSystemCommands| |unab| - |optionList|)) - ('T - (|handleParsedSystemCommands| |unab| - |optionList|) - NIL))))) - ('T NIL)))))))) - ;npboot str == ; sex := string2BootTree str ; FORMAT(true, '"~&~S~%", sex) @@ -2085,385 +1970,10 @@ (SPADLET |$ans| (EVAL |sex|)) (FORMAT 'T (MAKESTRING "~&Value = ~S~%") |$ans|))))) -;npsynonym(unab, str) == -; npProcessSynonym(str) - -;tokenSystemCommand(unabr, tokList) == -; systemCommand tokList - -(DEFUN |tokenSystemCommand| (|unabr| |tokList|) - (|systemCommand| |tokList|)) - -;tokTran tok == -; STRINGP tok => -; #tok = 0 => nil -; isIntegerString tok => READ_-FROM_-STRING tok -; STRING tok.0 = '"_"" => -; SUBSEQ(tok, 1, #tok-1) -; INTERN tok -; tok - -(DEFUN |tokTran| (|tok|) - (COND - ((STRINGP |tok|) - (COND - ((EQL (|#| |tok|) 0) NIL) - ((|isIntegerString| |tok|) (READ-FROM-STRING |tok|)) - ((BOOT-EQUAL (STRING (ELT |tok| 0)) (MAKESTRING "\"")) - (SUBSEQ |tok| 1 (SPADDIFFERENCE (|#| |tok|) 1))) - ('T (INTERN |tok|)))) - ('T |tok|))) - -;isIntegerString tok == -; for i in 0..#tok-1 repeat -; val := DIGIT_-CHAR_-P tok.i -; not val => return nil -; val - -(DEFUN |isIntegerString| (|tok|) - (PROG (|val|) - (RETURN - (SEQ (PROGN - (DO ((G167273 (SPADDIFFERENCE (|#| |tok|) 1)) - (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| G167273) NIL) - (SEQ (EXIT (PROGN - (SPADLET |val| - (DIGIT-CHAR-P (ELT |tok| |i|))) - (COND ((NULL |val|) (RETURN NIL))))))) - |val|))))) - -;splitIntoOptionBlocks str == -; inString := false -; optionBlocks := nil -; blockStart := 0 -; parenCount := 0 -; for i in 0..#str-1 repeat -; STRING str.i = '"_"" => -; inString := not inString -; if STRING str.i = '"(" and not inString -; then parenCount := parenCount + 1 -; if STRING str.i = '")" and not inString -; then parenCount := parenCount - 1 -; STRING str.i = '")" and not inString and parenCount = -1 => -; block := stripSpaces SUBSEQ(str, blockStart, i) -; blockList := [block, :blockList] -; blockStart := i+1 -; parenCount := 0 -; blockList := [stripSpaces SUBSEQ(str, blockStart), :blockList] -; nreverse blockList - -(DEFUN |splitIntoOptionBlocks| (|str|) - (PROG (|optionBlocks| |inString| |block| |blockStart| |parenCount| - |blockList|) - (RETURN - (SEQ (PROGN - (SPADLET |inString| NIL) - (SPADLET |optionBlocks| NIL) - (SPADLET |blockStart| 0) - (SPADLET |parenCount| 0) - (DO ((G167291 (SPADDIFFERENCE (|#| |str|) 1)) - (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| G167291) NIL) - (SEQ (EXIT (COND - ((BOOT-EQUAL (STRING (ELT |str| |i|)) - (MAKESTRING "\"")) - (SPADLET |inString| (NULL |inString|))) - ('T - (COND - ((AND (BOOT-EQUAL - (STRING (ELT |str| |i|)) - (MAKESTRING "(")) - (NULL |inString|)) - (SPADLET |parenCount| - (PLUS |parenCount| 1)))) - (COND - ((AND (BOOT-EQUAL - (STRING (ELT |str| |i|)) - (MAKESTRING ")")) - (NULL |inString|)) - (SPADLET |parenCount| - (SPADDIFFERENCE |parenCount| - 1)))) - (COND - ((AND (BOOT-EQUAL - (STRING (ELT |str| |i|)) - (MAKESTRING ")")) - (NULL |inString|) - (BOOT-EQUAL |parenCount| - (SPADDIFFERENCE 1))) - (PROGN - (SPADLET |block| - (|stripSpaces| - (SUBSEQ |str| |blockStart| - |i|))) - (SPADLET |blockList| - (CONS |block| |blockList|)) - (SPADLET |blockStart| (PLUS |i| 1)) - (SPADLET |parenCount| 0))))))))) - (SPADLET |blockList| - (CONS (|stripSpaces| (SUBSEQ |str| |blockStart|)) - |blockList|)) - (NREVERSE |blockList|)))))) - -;dumbTokenize str == -; -- split into tokens delimted by spaces, taking quoted strings into account -; inString := false -; tokenList := nil -; tokenStart := 0 -; previousSpace := false -; for i in 0..#str-1 repeat -; STRING str.i = '"_"" => -; inString := not inString -; previousSpace := false -; STRING str.i = '" " and not inString => -; previousSpace => nil -; token := stripSpaces SUBSEQ(str, tokenStart, i) -; tokenList := [token, :tokenList] -; tokenStart := i+1 -; previousSpace := true -; previousSpace := false -; tokenList := [stripSpaces SUBSEQ(str, tokenStart), :tokenList] -; nreverse tokenList - -(DEFUN |dumbTokenize| (|str|) - (PROG (|inString| |token| |tokenStart| |previousSpace| |tokenList|) - (RETURN - (SEQ (PROGN - (SPADLET |inString| NIL) - (SPADLET |tokenList| NIL) - (SPADLET |tokenStart| 0) - (SPADLET |previousSpace| NIL) - (DO ((G167317 (SPADDIFFERENCE (|#| |str|) 1)) - (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| G167317) NIL) - (SEQ (EXIT (COND - ((BOOT-EQUAL (STRING (ELT |str| |i|)) - (MAKESTRING "\"")) - (SPADLET |inString| (NULL |inString|)) - (SPADLET |previousSpace| NIL)) - ((AND (BOOT-EQUAL (STRING (ELT |str| |i|)) - (MAKESTRING " ")) - (NULL |inString|)) - (COND - (|previousSpace| NIL) - ('T - (SPADLET |token| - (|stripSpaces| - (SUBSEQ |str| |tokenStart| - |i|))) - (SPADLET |tokenList| - (CONS |token| |tokenList|)) - (SPADLET |tokenStart| (PLUS |i| 1)) - (SPADLET |previousSpace| 'T)))) - ('T (SPADLET |previousSpace| NIL)))))) - (SPADLET |tokenList| - (CONS (|stripSpaces| (SUBSEQ |str| |tokenStart|)) - |tokenList|)) - (NREVERSE |tokenList|)))))) - -;handleParsedSystemCommands(unabr, optionList) == -; restOptionList := [dumbTokenize opt for opt in CDR optionList] -; parcmd := [parseSystemCmd CAR optionList, -; :[[tokTran tok for tok in opt] for opt in restOptionList]] -; systemCommand parcmd - -(DEFUN |handleParsedSystemCommands| (|unabr| |optionList|) - (PROG (|restOptionList| |parcmd|) - (RETURN - (SEQ (PROGN - (SPADLET |restOptionList| - (PROG (G167341) - (SPADLET G167341 NIL) - (RETURN - (DO ((G167346 (CDR |optionList|) - (CDR G167346)) - (|opt| NIL)) - ((OR (ATOM G167346) - (PROGN - (SETQ |opt| (CAR G167346)) - NIL)) - (NREVERSE0 G167341)) - (SEQ (EXIT (SETQ G167341 - (CONS (|dumbTokenize| |opt|) - G167341)))))))) - (SPADLET |parcmd| - (CONS (|parseSystemCmd| (CAR |optionList|)) - (PROG (G167356) - (SPADLET G167356 NIL) - (RETURN - (DO ((G167361 |restOptionList| - (CDR G167361)) - (|opt| NIL)) - ((OR (ATOM G167361) - (PROGN - (SETQ |opt| (CAR G167361)) - NIL)) - (NREVERSE0 G167356)) - (SEQ (EXIT - (SETQ G167356 - (CONS - (PROG (G167371) - (SPADLET G167371 NIL) - (RETURN - (DO - ((G167376 |opt| - (CDR G167376)) - (|tok| NIL)) - ((OR (ATOM G167376) - (PROGN - (SETQ |tok| - (CAR G167376)) - NIL)) - (NREVERSE0 G167371)) - (SEQ - (EXIT - (SETQ G167371 - (CONS - (|tokTran| |tok|) - G167371))))))) - G167356))))))))) - (|systemCommand| |parcmd|)))))) - -;parseSystemCmd opt == -; spaceIndex := SEARCH('" ", opt) -; spaceIndex => -; commandString := stripSpaces SUBSEQ(opt, 0, spaceIndex) -; argString := stripSpaces SUBSEQ(opt, spaceIndex) -; command := tokTran commandString -; pform := parseFromString argString -; [command, pform] -; [tokTran tok for tok in dumbTokenize opt] - -(DEFUN |parseSystemCmd| (|opt|) - (PROG (|spaceIndex| |commandString| |argString| |command| |pform|) - (RETURN - (SEQ (PROGN - (SPADLET |spaceIndex| (SEARCH (MAKESTRING " ") |opt|)) - (COND - (|spaceIndex| - (SPADLET |commandString| - (|stripSpaces| - (SUBSEQ |opt| 0 |spaceIndex|))) - (SPADLET |argString| - (|stripSpaces| (SUBSEQ |opt| |spaceIndex|))) - (SPADLET |command| (|tokTran| |commandString|)) - (SPADLET |pform| (|parseFromString| |argString|)) - (CONS |command| (CONS |pform| NIL))) - ('T - (PROG (G167396) - (SPADLET G167396 NIL) - (RETURN - (DO ((G167401 (|dumbTokenize| |opt|) - (CDR G167401)) - (|tok| NIL)) - ((OR (ATOM G167401) - (PROGN (SETQ |tok| (CAR G167401)) NIL)) - (NREVERSE0 G167396)) - (SEQ (EXIT (SETQ G167396 - (CONS (|tokTran| |tok|) - G167396)))))))))))))) - -;handleTokensizeSystemCommands(unabr, optionList) == -; optionList := [dumbTokenize opt for opt in optionList] -; parcmd := [[tokTran tok for tok in opt] for opt in optionList] -; parcmd => tokenSystemCommand(unabr, parcmd) - -(DEFUN |handleTokensizeSystemCommands| (|unabr| |optionList|) - (PROG (|parcmd|) - (RETURN - (SEQ (PROGN - (SPADLET |optionList| - (PROG (G167437) - (SPADLET G167437 NIL) - (RETURN - (DO ((G167442 |optionList| (CDR G167442)) - (|opt| NIL)) - ((OR (ATOM G167442) - (PROGN - (SETQ |opt| (CAR G167442)) - NIL)) - (NREVERSE0 G167437)) - (SEQ (EXIT (SETQ G167437 - (CONS (|dumbTokenize| |opt|) - G167437)))))))) - (SPADLET |parcmd| - (PROG (G167452) - (SPADLET G167452 NIL) - (RETURN - (DO ((G167457 |optionList| (CDR G167457)) - (|opt| NIL)) - ((OR (ATOM G167457) - (PROGN - (SETQ |opt| (CAR G167457)) - NIL)) - (NREVERSE0 G167452)) - (SEQ (EXIT (SETQ G167452 - (CONS - (PROG (G167467) - (SPADLET G167467 NIL) - (RETURN - (DO - ((G167472 |opt| - (CDR G167472)) - (|tok| NIL)) - ((OR (ATOM G167472) - (PROGN - (SETQ |tok| - (CAR G167472)) - NIL)) - (NREVERSE0 G167467)) - (SEQ - (EXIT - (SETQ G167467 - (CONS - (|tokTran| |tok|) - G167467))))))) - G167452)))))))) - (COND (|parcmd| (|tokenSystemCommand| |unabr| |parcmd|)))))))) - -;getFirstWord string == -; spaceIndex := SEARCH('" ", string) -; null spaceIndex => string -; stripSpaces SUBSEQ(string, 0, spaceIndex) - -(DEFUN |getFirstWord| (|string|) - (PROG (|spaceIndex|) - (RETURN - (PROGN - (SPADLET |spaceIndex| (SEARCH (MAKESTRING " ") |string|)) - (COND - ((NULL |spaceIndex|) |string|) - ('T (|stripSpaces| (SUBSEQ |string| 0 |spaceIndex|)))))))) - ;ltrace l == trace l (DEFUN |ltrace| (|l|) (|trace| |l|)) -;npProcessSynonym(str) == -; if str = '"" then printSynonyms(NIL) -; else -; pair := processSynonymLine str -; if $CommandSynonymAlist then -; PUTALIST($CommandSynonymAlist,CAR pair, CDR pair) -; else $CommandSynonymAlist := [pair] -; terminateSystemCommand() - -(DEFUN |npProcessSynonym| (|str|) - (PROG (|pair|) - (declare (special |$CommandSynonymAlist|)) - (RETURN - (PROGN - (COND - ((BOOT-EQUAL |str| (MAKESTRING "")) (|printSynonyms| NIL)) - ('T (SPADLET |pair| (|processSynonymLine| |str|)) - (COND - (|$CommandSynonymAlist| - (PUTALIST |$CommandSynonymAlist| (CAR |pair|) - (CDR |pair|))) - ('T (SPADLET |$CommandSynonymAlist| (CONS |pair| NIL)))))) - (|terminateSystemCommand|))))) - @ \eject \begin{thebibliography}{99}