From 69aed4d7df4e7dddb237329a4d032cbdbf858883 Mon Sep 17 00:00:00 2001 From: Tim Daly Date: Wed, 29 Apr 2015 01:53:50 -0400 Subject: [PATCH] src/interp/vmlisp.lisp sayString to PRINTEXP to PRINC Remove a layer of function call and redirection; use Lisp primitive --- books/bookvol10.3.pamphlet | 8 +- changelog | 11 + patch | 4 +- src/axiom-website/patches.html | 2 + src/interp/br-con.lisp.pamphlet | 172 +++++++++--------- src/interp/c-util.lisp.pamphlet | 4 +- src/interp/g-error.lisp.pamphlet | 45 +----- src/interp/i-output.lisp.pamphlet | 16 +- src/interp/msgdb.lisp.pamphlet | 372 ++++++++++++++++++------------------- src/interp/newfort.lisp.pamphlet | 4 +- src/interp/record.lisp.pamphlet | 20 +- src/interp/sys-pkg.lisp.pamphlet | 3 +- src/interp/vmlisp.lisp.pamphlet | 1 - 13 files changed, 308 insertions(+), 354 deletions(-) diff --git a/books/bookvol10.3.pamphlet b/books/bookvol10.3.pamphlet index a297c74..ee1e41e 100644 --- a/books/bookvol10.3.pamphlet +++ b/books/bookvol10.3.pamphlet @@ -54430,11 +54430,11 @@ FortranTemplate() : specification == implementation where Rep := TextFile fortranLiteralLine(s:String):Void == - PRINTEXP(s,_$fortranOutputStream$Lisp)$Lisp + PRINC(s,_$fortranOutputStream$Lisp)$Lisp TERPRI(_$fortranOutputStream$Lisp)$Lisp fortranLiteral(s:String):Void == - PRINTEXP(s,_$fortranOutputStream$Lisp)$Lisp + PRINC(s,_$fortranOutputStream$Lisp)$Lisp fortranCarriageReturn():Void == TERPRI(_$fortranOutputStream$Lisp)$Lisp @@ -142115,7 +142115,7 @@ TextFile: Cat == Def where s write_!(f, x) == f.fileIOmode ^= "output" => error "File not in write state" - PRINTEXP(x, f.fileState)$Lisp + PRINC(x, f.fileState)$Lisp x writeLine_! f == f.fileIOmode ^= "output" => error "File not in write state" @@ -142123,7 +142123,7 @@ TextFile: Cat == Def where "" writeLine_!(f, x) == f.fileIOmode ^= "output" => error "File not in write state" - PRINTEXP(x, f.fileState)$Lisp + PRINC(x, f.fileState)$Lisp TERPRI(f.fileState)$Lisp x endOfFile? f == diff --git a/changelog b/changelog index bcb0c6a..c5197d7 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,14 @@ +20150429 tpd src/axiom-website/patches.html 20150429.01.tpd.patch +20150429 tpd books/bookvol10.3 remove sayString +20150429 tpd src/interp/br-con.lisp remove sayString +20150429 tpd src/interp/c-util.lisp remove sayString +20150429 tpd src/interp/g-error.lisp remove sayString +20150429 tpd src/interp/i-output.lisp remove sayString +20150429 tpd src/interp/msgdb.lisp remove sayString +20150429 tpd src/interp/newfort.lisp remove sayString +20150429 tpd src/interp/record.lisp remove sayString +20150429 tpd src/interp/sys-pkg.lisp remove sayString +20150429 tpd src/interp/vmlisp.lisp sayString to PRINTEXP to PRINC 20150428 tpd src/axiom-website/patches.html 20150428.01.tpd.patch 20150428 tpd books/bookvol5 reduce the use of spadlet 20150428 tpd books/bookvol9 reduce the use of spadlet diff --git a/patch b/patch index 21dc0fe..5f65399 100644 --- a/patch +++ b/patch @@ -1,3 +1,3 @@ -src/interp/vmlisp.lisp reduce the use of spadlet +src/interp/vmlisp.lisp sayString to PRINTEXP to PRINC -Lisp knows about setq and optimizations. +Remove a layer of function call and redirection; use Lisp primitive diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 984ffdd..d1b3646 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -5042,6 +5042,8 @@ books/bookvol5 move/collect/reorder algebra support code
src/interp/vmlisp.lisp shrink vmlisp.lisp
20150428.01.tpd.patch src/interp/vmlisp.lisp reduce the use of spadlet
+20150429.01.tpd.patch +src/interp/vmlisp.lisp sayString to PRINTEXP to PRINC
diff --git a/src/interp/br-con.lisp.pamphlet b/src/interp/br-con.lisp.pamphlet index 17b2a00..33ae713 100644 --- a/src/interp/br-con.lisp.pamphlet +++ b/src/interp/br-con.lisp.pamphlet @@ -14,7 +14,7 @@ ;writedb(u) == ; not STRINGP u => nil --skip if not a string -; PRINTEXP(addPatchesToLongLines(u,500),$outStream) +; PRINC(addPatchesToLongLines(u,500),$outStream) ; --positions for tick(1), dashes(2), and address(9), i.e. 12 ; TERPRI $outStream @@ -22,7 +22,7 @@ (declare (special |$outStream|)) (COND ((NULL (STRINGP |u|)) NIL) - ('T (PRINTEXP (|addPatchesToLongLines| |u| 500) |$outStream|) + ('T (PRINC (|addPatchesToLongLines| |u| 500) |$outStream|) (TERPRI |$outStream|)))) ;addPatchesToLongLines(s,n) == @@ -243,30 +243,30 @@ ; instream := MAKE_-INSTREAM '"olibdb.text" ; outstream:= MAKE_-OUTSTREAM '"libdb.text" ; comstream:= MAKE_-OUTSTREAM '"comdb.text" -; PRINTEXP(0, comstream) -; PRINTEXP($tick,comstream) -; PRINTEXP('"", comstream) +; PRINC(0, comstream) +; PRINC($tick,comstream) +; PRINC('"", comstream) ; TERPRI(comstream) ; while not EOFP instream repeat ; line := READLINE instream ; outP := FILE_-POSITION outstream ; comP := FILE_-POSITION comstream ; [prefix,:comments] := dbSplit(line,6,1) -; PRINTEXP(prefix,outstream) -; PRINTEXP($tick ,outstream) +; PRINC(prefix,outstream) +; PRINC($tick ,outstream) ; null comments => -; PRINTEXP(0,outstream) +; PRINC(0,outstream) ; TERPRI(outstream) -; PRINTEXP(comP,outstream) +; PRINC(comP,outstream) ; TERPRI(outstream) -; PRINTEXP(outP ,comstream) -; PRINTEXP($tick ,comstream) -; PRINTEXP(first comments,comstream) +; PRINC(outP ,comstream) +; PRINC($tick ,comstream) +; PRINC(first comments,comstream) ; TERPRI(comstream) ; for c in rest comments repeat -; PRINTEXP(outP ,comstream) -; PRINTEXP($tick ,comstream) -; PRINTEXP(c, comstream) +; PRINC(outP ,comstream) +; PRINC($tick ,comstream) +; PRINC(c, comstream) ; TERPRI(comstream) ; SHUT instream ; SHUT outstream @@ -285,9 +285,9 @@ (MAKE-OUTSTREAM "libdb.text")) (setq |comstream| (MAKE-OUTSTREAM "comdb.text")) - (PRINTEXP 0 |comstream|) - (PRINTEXP |$tick| |comstream|) - (PRINTEXP "" |comstream|) + (PRINC 0 |comstream|) + (PRINC |$tick| |comstream|) + (PRINC "" |comstream|) (TERPRI |comstream|) (DO () ((NULL (NULL (EOFP |instream|))) NIL) (SEQ (EXIT (PROGN @@ -299,17 +299,17 @@ (setq |LETTMP#1| (|dbSplit| |line| 6 1)) (setq |prefix| (CAR |LETTMP#1|)) (setq |comments| (CDR |LETTMP#1|)) - (PRINTEXP |prefix| |outstream|) - (PRINTEXP |$tick| |outstream|) + (PRINC |prefix| |outstream|) + (PRINC |$tick| |outstream|) (COND ((NULL |comments|) - (PRINTEXP 0 |outstream|) + (PRINC 0 |outstream|) (TERPRI |outstream|)) - ('T (PRINTEXP |comP| |outstream|) + ('T (PRINC |comP| |outstream|) (TERPRI |outstream|) - (PRINTEXP |outP| |comstream|) - (PRINTEXP |$tick| |comstream|) - (PRINTEXP (CAR |comments|) |comstream|) + (PRINC |outP| |comstream|) + (PRINC |$tick| |comstream|) + (PRINC (CAR |comments|) |comstream|) (TERPRI |comstream|) (DO ((G168593 (CDR |comments|) (CDR G168593)) @@ -321,9 +321,9 @@ NIL) (SEQ (EXIT (PROGN - (PRINTEXP |outP| |comstream|) - (PRINTEXP |$tick| |comstream|) - (PRINTEXP |c| |comstream|) + (PRINC |outP| |comstream|) + (PRINC |$tick| |comstream|) + (PRINC |c| |comstream|) (TERPRI |comstream|))))))))))) (SHUT |instream|) (SHUT |outstream|) @@ -395,30 +395,30 @@ ; defpath := '"glossdef.text" ; defstream:= MAKE_-OUTSTREAM defpath ; pairs := getGlossLines instream -; PRINTEXP('"\begin{page}{GlossaryPage}{G l o s s a r y}\beginscroll\beginmenu",htstream) +; PRINC('"\begin{page}{GlossaryPage}{G l o s s a r y}\beginscroll\beginmenu",htstream) ; for [name,:line] in pairs repeat ; outP := FILE_-POSITION outstream ; defP := FILE_-POSITION defstream ; lines := spreadGlossText transformAndRecheckComments(name,[line]) -; PRINTEXP(name, outstream) -; PRINTEXP($tick,outstream) -; PRINTEXP(defP, outstream) +; PRINC(name, outstream) +; PRINC($tick,outstream) +; PRINC(defP, outstream) ; TERPRI(outstream) -;-- PRINTEXP('"\item\newline{\em \menuitemstyle{}}\tab{0}{\em ",htstream) -; PRINTEXP('"\item\newline{\em \menuitemstyle{}}{\em ",htstream) -; PRINTEXP(name, htstream) -; PRINTEXP('"}\space{}",htstream) +;-- PRINC('"\item\newline{\em \menuitemstyle{}}\tab{0}{\em ",htstream) +; PRINC('"\item\newline{\em \menuitemstyle{}}{\em ",htstream) +; PRINC(name, htstream) +; PRINC('"}\space{}",htstream) ; TERPRI(htstream) ; for x in lines repeat -; PRINTEXP(outP, defstream) -; PRINTEXP($tick,defstream) -; PRINTEXP(x, defstream) +; PRINC(outP, defstream) +; PRINC($tick,defstream) +; PRINC(x, defstream) ; TERPRI defstream -; PRINTEXP("STRCONC"/lines,htstream) +; PRINC("STRCONC"/lines,htstream) ; TERPRI htstream -; PRINTEXP('"\endmenu\endscroll",htstream) -; PRINTEXP('"\lispdownlink{Search}{(|htGloss| _"\stringvalue{pattern}_")} for glossary entry matching \inputstring{pattern}{24}{*}",htstream) -; PRINTEXP('"\end{page}",htstream) +; PRINC('"\endmenu\endscroll",htstream) +; PRINC('"\lispdownlink{Search}{(|htGloss| _"\stringvalue{pattern}_")} for glossary entry matching \inputstring{pattern}{24}{*}",htstream) +; PRINC('"\end{page}",htstream) ; SHUT instream ; SHUT outstream ; SHUT defstream @@ -453,7 +453,7 @@ (setq |defpath| "glossdef.text") (setq |defstream| (MAKE-OUTSTREAM |defpath|)) (setq |pairs| (|getGlossLines| |instream|)) - (PRINTEXP + (PRINC "\\begin{page}{GlossaryPage}{G l o s s a r y}\\beginscroll\\beginmenu" |htstream|) (DO ((G168653 |pairs| (CDR G168653)) (G168626 NIL)) @@ -475,15 +475,15 @@ (|spreadGlossText| (|transformAndRecheckComments| |name| (CONS |line| NIL)))) - (PRINTEXP |name| |outstream|) - (PRINTEXP |$tick| |outstream|) - (PRINTEXP |defP| |outstream|) + (PRINC |name| |outstream|) + (PRINC |$tick| |outstream|) + (PRINC |defP| |outstream|) (TERPRI |outstream|) - (PRINTEXP + (PRINC "\\item\\newline{\\em \\menuitemstyle{}}{\\em " |htstream|) - (PRINTEXP |name| |htstream|) - (PRINTEXP "}\\space{}" + (PRINC |name| |htstream|) + (PRINC "}\\space{}" |htstream|) (TERPRI |htstream|) (DO ((G168667 |lines| (CDR G168667)) @@ -495,11 +495,11 @@ NIL) (SEQ (EXIT (PROGN - (PRINTEXP |outP| |defstream|) - (PRINTEXP |$tick| |defstream|) - (PRINTEXP |x| |defstream|) + (PRINC |outP| |defstream|) + (PRINC |$tick| |defstream|) + (PRINC |x| |defstream|) (TERPRI |defstream|))))) - (PRINTEXP + (PRINC (PROG (G168673) (setq G168673 "") (RETURN @@ -519,11 +519,11 @@ (STRCONC G168673 G168623))))))) |htstream|) (TERPRI |htstream|))))) - (PRINTEXP "\\endmenu\\endscroll" |htstream|) - (PRINTEXP + (PRINC "\\endmenu\\endscroll" |htstream|) + (PRINC "\\lispdownlink{Search}{(|htGloss| \"\\stringvalue{pattern}\")} for glossary entry matching \\inputstring{pattern}{24}{*}" |htstream|) - (PRINTEXP "\\end{page}" |htstream|) + (PRINC "\\end{page}" |htstream|) (SHUT |instream|) (SHUT |outstream|) (SHUT |defstream|) @@ -16460,13 +16460,13 @@ $dbKindAlist := NIL)))))))))))))))) ;writeSaturnSuffix() == -; $saturnContextMenuLines => saturnPRINTEXP '"}}" +; $saturnContextMenuLines => saturnPRINC '"}}" (defun |writeSaturnSuffix| () (declare (special |$saturnContextMenuLines|)) (SEQ (COND (|$saturnContextMenuLines| - (EXIT (|saturnPRINTEXP| "}}")))))) + (EXIT (|saturnPRINC| "}}")))))) ;issueHTStandard line == --called by htMakePageNoScroll and htMakeErrorPage ; if $standard then @@ -16511,7 +16511,7 @@ $dbKindAlist := ;writeSaturnLines lines == ; for line in lines repeat ; if line ^= '"" and line.0 = char '_\ then saturnTERPRI() -; saturnPRINTEXP line +; saturnPRINC line (defun |writeSaturnLines| (|lines|) (SEQ (DO ((G178298 |lines| (CDR G178298)) (|line| NIL)) @@ -16524,7 +16524,7 @@ $dbKindAlist := (BOOT-EQUAL (ELT |line| 0) (|char| '|\\|))) (|saturnTERPRI|))) - (|saturnPRINTEXP| |line|))))))) + (|saturnPRINC| |line|))))))) ;writeSaturn(line) == ; k := 0 @@ -16756,8 +16756,8 @@ $dbKindAlist := ('T NIL))))))) ;writeSaturnPrint s == -; for i in 0..($marg - 1) repeat saturnPRINTEXP '" " -; saturnPRINTEXP s +; for i in 0..($marg - 1) repeat saturnPRINC '" " +; saturnPRINC s ; saturnTERPRI() (defun |writeSaturnPrint| (|s|) @@ -16766,19 +16766,19 @@ $dbKindAlist := (DO ((G178364 (SPADDIFFERENCE |$marg| 1)) (|i| 0 (QSADD1 |i|))) ((QSGREATERP |i| G178364) NIL) - (SEQ (EXIT (|saturnPRINTEXP| " ")))) - (|saturnPRINTEXP| |s|) + (SEQ (EXIT (|saturnPRINC| " ")))) + (|saturnPRINC| |s|) (|saturnTERPRI|)))) -;saturnPRINTEXP s == -; $browserOutputStream => PRINTEXP(s,$browserOutputStream) -; PRINTEXP s +;saturnPRINC s == +; $browserOutputStream => PRINC(s,$browserOutputStream) +; PRINC s -(defun |saturnPRINTEXP| (|s|) +(defun |saturnPRINC| (|s|) (declare (special |$browserOutputStream| |$browserOutputStream|)) (COND - (|$browserOutputStream| (PRINTEXP |s| |$browserOutputStream|)) - ('T (PRINTEXP |s|)))) + (|$browserOutputStream| (PRINC |s| |$browserOutputStream|)) + ('T (PRINC |s|)))) ;saturnTERPRI() == ; $browserOutputStream => TERPRI($browserOutputStream) @@ -20832,9 +20832,9 @@ $dbKindAlist := ;-- key := nil --dummy first key ;-- instream := MAKE_-INSTREAM '"libdb.text" ;-- comstream := MAKE_-OUTSTREAM '"comdb.text" -;-- PRINTEXP(0, comstream) -;-- PRINTEXP($tick,comstream) -;-- PRINTEXP('"", comstream) +;-- PRINC(0, comstream) +;-- PRINC($tick,comstream) +;-- PRINC('"", comstream) ;-- TERPRI(comstream) ;-- while not EOFP instream repeat ;-- line := READLINE instream @@ -20845,23 +20845,23 @@ $dbKindAlist := ;-- outstream := MAKE_-OUTSTREAM STRCONC(STRINGIMAGE key,'"libdb.text") ;-- outP := FILE_-POSITION outstream ;-- [prefix,:comments] := dbSplit(line,6,1) -;-- PRINTEXP(prefix,outstream) -;-- PRINTEXP($tick ,outstream) +;-- PRINC(prefix,outstream) +;-- PRINC($tick ,outstream) ;-- null comments => -;-- PRINTEXP(0,outstream) +;-- PRINC(0,outstream) ;-- TERPRI(outstream) -;-- PRINTEXP(comP,outstream) +;-- PRINC(comP,outstream) ;-- TERPRI(outstream) -;-- PRINTEXP(key, comstream) --identifies file the backpointer is to -;-- PRINTEXP(outP ,comstream) -;-- PRINTEXP($tick ,comstream) -;-- PRINTEXP(first comments,comstream) +;-- PRINC(key, comstream) --identifies file the backpointer is to +;-- PRINC(outP ,comstream) +;-- PRINC($tick ,comstream) +;-- PRINC(first comments,comstream) ;-- TERPRI(comstream) ;-- for c in rest comments repeat -;-- PRINTEXP(key, comstream) --identifies file the backpointer is to -;-- PRINTEXP(outP ,comstream) -;-- PRINTEXP($tick ,comstream) -;-- PRINTEXP(c, comstream) +;-- PRINC(key, comstream) --identifies file the backpointer is to +;-- PRINC(outP ,comstream) +;-- PRINC($tick ,comstream) +;-- PRINC(c, comstream) ;-- TERPRI(comstream) ;-- SHUT instream ;-- SHUT outstream diff --git a/src/interp/c-util.lisp.pamphlet b/src/interp/c-util.lisp.pamphlet index f242d3a..6e2ca61 100644 --- a/src/interp/c-util.lisp.pamphlet +++ b/src/interp/c-util.lisp.pamphlet @@ -1934,12 +1934,12 @@ (THROW '|compOrCroak| NIL))) ; -;printString x == PRINTEXP (STRINGP x => x; PNAME x) +;printString x == PRINC (STRINGP x => x; PNAME x) ;;; *** |printString| REDEFINED (DEFUN |printString| (|x|) - (PRINTEXP (COND ((STRINGP |x|) |x|) ('T (PNAME |x|))))) + (PRINC (COND ((STRINGP |x|) |x|) ('T (PNAME |x|))))) ; ;printAny x == if atom x then printString x else PRIN0 x diff --git a/src/interp/g-error.lisp.pamphlet b/src/interp/g-error.lisp.pamphlet index 040e942..5fdb8c5 100644 --- a/src/interp/g-error.lisp.pamphlet +++ b/src/interp/g-error.lisp.pamphlet @@ -261,50 +261,7 @@ (|sayBrightly| '(" Continuing to read the file..." |%l|)) (throw 'spad_reader nil)))) -;sayErrorly(errorLabel, msg) == -; $saturn => saturnSayErrorly(errorLabel, msg) -; sayErrorly1(errorLabel, msg) - -(defun |sayErrorly| (|errorLabel| |msg|) - (declare (special |$saturn|)) - (if |$saturn| - (|saturnSayErrorly| |errorLabel| |msg|) - (|sayErrorly1| |errorLabel| |msg|))) - -;saturnSayErrorly(errorLabel, msg) == -; _*STANDARD_-OUTPUT_* : fluid := $texOutputStream -; old := pushSatOutput("line") -; sayString '"\bgroup\color{red}" -; sayString '"\begin{verbatim}" -; sayErrorly1(errorLabel, msg) -; sayString '"\end{verbatim}" -; sayString '"\egroup" -; popSatOutput(old) - -(DEFUN |saturnSayErrorly| (|errorLabel| |msg|) - (PROG (*STANDARD-OUTPUT* |old|) - (DECLARE (SPECIAL *STANDARD-OUTPUT* |$texOutputStream|)) - (RETURN - (PROGN - (setq *STANDARD-OUTPUT* |$texOutputStream|) - (setq |old| (|pushSatOutput| '|line|)) - (|sayString| "\\bgroup\\color{red}") - (|sayString| "\\begin{verbatim}") - (|sayErrorly1| |errorLabel| |msg|) - (|sayString| "\\end{verbatim}") - (|sayString| "\\egroup") - (|popSatOutput| |old|))))) - -;sayErrorly1(errorLabel, msg) == -; sayBrightly '" " -; if $testingSystem then sayMSG $testingErrorPrefix -; sayBrightly ['" >> ",errorLabel,'":"] -; m := msg -; msg is ['mathprint, mathexpr] => -; mathprint mathexpr -; sayBrightly msg - -(DEFUN |sayErrorly1| (|errorLabel| |msg|) +(DEFUN |sayErrorly| (|errorLabel| |msg|) (PROG (|m| |ISTMP#1| |mathexpr|) (DECLARE (SPECIAL |$testingErrorPrefix|)) (RETURN diff --git a/src/interp/i-output.lisp.pamphlet b/src/interp/i-output.lisp.pamphlet index 2e2c55e..9a4bc8b 100644 --- a/src/interp/i-output.lisp.pamphlet +++ b/src/interp/i-output.lisp.pamphlet @@ -4716,7 +4716,7 @@ NIL ;printBasic x == ; x='(One) => PRIN1(1,$algebraOutputStream) ; x='(Zero) => PRIN1(0,$algebraOutputStream) -; IDENTP x => PRINTEXP(PNAME x,$algebraOutputStream) +; IDENTP x => PRINC(PNAME x,$algebraOutputStream) ; atom x => PRIN1(x,$algebraOutputStream) ; PRIN0(x,$algebraOutputStream) @@ -4725,7 +4725,7 @@ NIL (COND ((BOOT-EQUAL |x| '(|One|)) (PRIN1 1 |$algebraOutputStream|)) ((BOOT-EQUAL |x| '(|Zero|)) (PRIN1 0 |$algebraOutputStream|)) - ((IDENTP |x|) (PRINTEXP (PNAME |x|) |$algebraOutputStream|)) + ((IDENTP |x|) (PRINC (PNAME |x|) |$algebraOutputStream|)) ((ATOM |x|) (PRIN1 |x| |$algebraOutputStream|)) ('T (PRIN0 |x| |$algebraOutputStream|)))) @@ -5268,7 +5268,7 @@ NIL ; if $collectOutput then ; $outputLines := [y, :$outputLines] ; else -; PRINTEXP(y,$algebraOutputStream) +; PRINC(y,$algebraOutputStream) ; TERPRI $algebraOutputStream ; nil @@ -5288,7 +5288,7 @@ NIL (COND (|$collectOutput| (setq |$outputLines| (CONS |y| |$outputLines|))) - ('T (PRINTEXP |y| |$algebraOutputStream|) + ('T (PRINC |y| |$algebraOutputStream|) (TERPRI |$algebraOutputStream|))) NIL)))))) @@ -6676,11 +6676,11 @@ NIL ; $testOutputLineFlag => ; string := STRCONC(fillerSpaces MAX(0,start - 1),op) ; $testOutputLineList := [string,:$testOutputLineList] -; PRINTEXP(fillerSpaces MAX(0,start - 1),$algebraOutputStream) +; PRINC(fillerSpaces MAX(0,start - 1),$algebraOutputStream) ; $collectOutput => ; string := STRCONC(fillerSpaces MAX(0,start - 1),op) ; $outputLines := [string, :$outputLines] -; PRINTEXP(op,$algebraOutputStream) +; PRINC(op,$algebraOutputStream) ; TERPRI $algebraOutputStream (DEFUN |prnd| (|start| |op|) @@ -6697,7 +6697,7 @@ NIL (setq |$testOutputLineList| (CONS |string| |$testOutputLineList|))) ('T - (PRINTEXP (|fillerSpaces| (MAX 0 (SPADDIFFERENCE |start| 1))) + (PRINC (|fillerSpaces| (MAX 0 (SPADDIFFERENCE |start| 1))) |$algebraOutputStream|) (COND (|$collectOutput| @@ -6706,7 +6706,7 @@ NIL (MAX 0 (SPADDIFFERENCE |start| 1))) |op|)) (setq |$outputLines| (CONS |string| |$outputLines|))) - ('T (PRINTEXP |op| |$algebraOutputStream|) + ('T (PRINC |op| |$algebraOutputStream|) (TERPRI |$algebraOutputStream|)))))))) ;qTSub(u) == diff --git a/src/interp/msgdb.lisp.pamphlet b/src/interp/msgdb.lisp.pamphlet index 85a6432..34b6183 100644 --- a/src/interp/msgdb.lisp.pamphlet +++ b/src/interp/msgdb.lisp.pamphlet @@ -38,7 +38,7 @@ (EQ (QCDR |ISTMP#2|) nil) (PROGN (setq |i| (QCAR |ISTMP#2|)) - 'T)))))) + t)))))) (NREVERSE0 G166078)) (SEQ (EXIT (SETQ G166078 (cons |w| G166078)))))))))))) @@ -71,7 +71,7 @@ (SEQ (EXIT (COND ((NEQUAL (ELT |l| |j|) - (|char| '| |)) + #\space) (SETQ G166098 (OR G166098 |j|))))))))) (RETURN nil))) @@ -79,20 +79,20 @@ (DO () ((NULL (AND (> |maxIndex| |k|) (NEQUAL (setq |c| (ELT |l| |k|)) - (|char| '| |)))) + #\space))) nil) (SEQ (EXIT (PROGN (setq |ch| (COND - ((BOOT-EQUAL |c| (|char| '_)) + ((BOOT-EQUAL |c| #\_) (ELT |l| (setq |k| (+ 1 |k|)))) - ('T |c|))) + (t |c|))) (setq |buf| (STRCONC |buf| |ch|)) (setq |k| (+ |k| 1)))))) (COND ((AND (BOOT-EQUAL |k| |maxIndex|) - (NEQUAL (setq |c| (ELT |l| |k|)) (|char| '| |))) + (NEQUAL (setq |c| (ELT |l| |k|)) #\space)) (setq |buf| (STRCONC |buf| |c|)))) (cons |buf| (cons (+ |k| 1) nil))))))) @@ -124,17 +124,17 @@ (RETURN (SEQ (COND ((ATOM |x|) |x|) - ('T (setq |head| (CAR |x|)) (setq |tail| (CDR |x|)) + (t (setq |head| (CAR |x|)) (setq |tail| (CDR |x|)) (setq |center| (setq |rightJust| nil)) (COND ((|member| |head| '(|%ceon| "%ceon")) - (setq |center| 'T))) + (setq |center| t))) (COND ((|member| |head| '(|%rjon| "%rjon")) - (setq |rightJust| 'T))) + (setq |rightJust| t))) (COND ((OR |center| |rightJust|) (setq |y| nil) - (setq |ok| 'T) + (setq |ok| t) (DO () ((NULL (AND |tail| |ok|)) nil) (SEQ (EXIT (PROGN (setq |LETTMP#1| |tail|) @@ -145,7 +145,7 @@ '(|%ceoff| "%ceoff" |%rjoff| "%rjoff")) (setq |ok| nil)) - ('T + (t (setq |y| (cons (|segmentedMsgPreprocess| |t|) @@ -153,17 +153,17 @@ (setq |head1| (cons (COND (|center| "%ce") - ('T "%rj")) + (t "%rj")) (NREVERSE |y|))) (COND ((NULL |tail|) (cons |head1| nil)) - ('T + (t (cons |head1| (|segmentedMsgPreprocess| |tail|))))) - ('T (setq |head1| (|segmentedMsgPreprocess| |head|)) + (t (setq |head1| (|segmentedMsgPreprocess| |head|)) (setq |tail1| (|segmentedMsgPreprocess| |tail|)) (COND ((AND (EQ |head| |head1|) (EQ |tail| |tail1|)) |x|) - ('T (cons |head1| |tail1|))))))))))) + (t (cons |head1| |tail1|))))))))))) ;removeAttributes msg == ; --takes a segmented message and returns it with the attributes @@ -185,7 +185,7 @@ (SEQ (COND ((NEQUAL (CAR |msg|) "%atbeg") (cons |msg| (cons nil nil))) - ('T (setq |attList| nil) + (t (setq |attList| nil) (DO ((G166190 nil (BOOT-EQUAL |item| "%atend"))) (G166190 nil) @@ -280,7 +280,7 @@ (|substituteSegmentedMsg| |x| |args|) |l|))) - ('T (setq |c| (ELT |x| 0)) + (t (setq |c| (ELT |x| 0)) (setq |n| (STRINGLENGTH |x|)) (COND ((AND (> |n| 2) (BOOT-EQUAL |c| '%) @@ -292,7 +292,7 @@ (SUBSTRING |x| 2 nil))) |l|))) ((AND (BOOT-EQUAL (ELT |x| 0) - (|char| '?)) + #\?) (> |n| 1) (setq |v| (|pushOrTypeFuture| (INTERN |x|) @@ -300,52 +300,52 @@ (setq |l| (NCONC (NREVERSE |v|) |l|))) ((AND (BOOT-EQUAL (ELT |x| 0) - (|char| '%)) + #\%) (> |n| 1) (DIGITP (ELT |x| 1))) (setq |a| (DIG2FIX (ELT |x| 1))) (setq |arg| (COND ((<= |a| |nargs|) (ELT |args| - (SPADDIFFERENCE |a| 1))) - ('T "???"))) + (- |a| 1))) + (t "???"))) (setq |q| nil) - (DO ((G166224 (SPADDIFFERENCE |n| 1)) - (|i| 2 (QSADD1 |i|))) + (DO ((G166224 (- |n| 1)) + (|i| 2 (1+ |i|))) ((QSGREATERP |i| G166224) nil) (SEQ (EXIT (setq |q| (cons (ELT |x| |i|) |q|))))) (COND - ((member (|char| '|f|) |q|) + ((member #\f |q|) (setq |arg| (COND ((consp |arg|) (APPLY (CAR |arg|) (CDR |arg|))) - ('T |arg|))))) + (t |arg|))))) (COND - ((member (|char| '|m|) |q|) + ((member #\m |q|) (setq |arg| (cons (cons "%m" |arg|) nil)))) (COND - ((member (|char| '|s|) |q|) + ((member #\s |q|) (setq |arg| (cons (cons "%s" |arg|) nil)))) (COND - ((member (|char| '|p|) |q|) + ((member #\p |q|) (COND (|$texFormatting| (setq |arg| (|prefix2StringAsTeX| |arg|))) - ('T + (t (setq |arg| (|prefix2String| |arg|)))))) (COND - ((member (|char| 'P) |q|) + ((member #\P |q|) (COND (|$texFormatting| (setq |arg| @@ -369,7 +369,7 @@ (|prefix2StringAsTeX| |x|) G166232))))))))) - ('T + (t (setq |arg| (PROG (G166247) (setq G166247 nil) @@ -391,24 +391,24 @@ (|prefix2String| |x|) G166247)))))))))))) (COND - ((AND (member (|char| '|o|) |q|) + ((AND (member #\o |q|) |$texFormatting|) (setq |arg| (|operationLink| |arg|)))) (COND - ((member (|char| '|c|) |q|) + ((member #\c |q|) (setq |arg| (cons (cons "%ce" |arg|) nil)))) (COND - ((member (|char| '|r|) |q|) + ((member #\r |q|) (setq |arg| (cons (cons "%rj" |arg|) nil)))) (COND - ((member (|char| '|l|) |q|) + ((member #\l |q|) (setq |l| (cons "%l" |l|)))) (setq |l| @@ -416,14 +416,14 @@ ((consp |arg|) (COND ((OR - (member (|char| '|y|) + (member #\y |q|) (BOOT-EQUAL (CAR |arg|) "%y") (EQL (LENGTH |arg|) 1)) (APPEND (REVERSE |arg|) |l|)) - ('T + (t (setq |head| (CAR |arg|)) (setq |tail| @@ -434,7 +434,7 @@ (cons "%n" (cons |head| |l|))))))) - ('T (cons |arg| |l|)))) + (t (cons |arg| |l|)))) (DO ((G166261 '(|.| |,| ! |:| |;| ?) (CDR G166261)) (|ch| nil)) @@ -445,11 +445,11 @@ nil) (SEQ (EXIT (COND - ((member (|char| |ch|) |q|) + ((member (character |ch|) |q|) (setq |l| (cons |ch| |l|))) - ('T nil)))))) - ('T (setq |l| (cons |x| |l|))))))))) + (t nil)))))) + (t (setq |l| (cons |x| |l|))))))))) (|addBlanks| (NREVERSE |l|))))))) ;addBlanks msg == @@ -482,11 +482,11 @@ ((NULL (consp |msg|)) |msg|) ((NULL |msg|) |msg|) ((EQL (LENGTH |msg|) 1) |msg|) - ('T (setq |blanksOff| nil) (setq |x| (CAR |msg|)) + (t (setq |blanksOff| nil) (setq |x| (CAR |msg|)) (COND ((BOOT-EQUAL |x| "%n") - (setq |blanksOff| 'T) (setq |msg1| nil)) - ('T (setq |msg1| (LIST |x|)))) + (setq |blanksOff| t) (setq |msg1| nil)) + (t (setq |msg1| (LIST |x|)))) (setq |blank| " ") (DO ((G166308 (CDR |msg|) (CDR G166308)) (|y| nil)) ((OR (ATOM G166308) @@ -494,16 +494,16 @@ nil) (SEQ (EXIT (COND ((|member| |y| '("%n" |%n|)) - (setq |blanksOff| 'T)) + (setq |blanksOff| t)) ((|member| |y| '("%y" |%y|)) (setq |blanksOff| nil)) - ('T + (t (COND ((OR (|noBlankAfterP| |x|) (|noBlankBeforeP| |y|) |blanksOff|) (setq |msg1| (cons |y| |msg1|))) - ('T + (t (setq |msg1| (cons |y| (cons |blank| |msg1|))))) @@ -528,20 +528,20 @@ (RETURN (COND ((integerp |word|) nil) - ((|member| |word| |$msgdbNoBlanksBeforeGroup|) 'T) - ('T + ((|member| |word| |$msgdbNoBlanksBeforeGroup|) t) + (t (COND ((AND (stringp |word|) (> (SIZE |word|) 1)) (COND - ((AND (BOOT-EQUAL (ELT |word| 0) (|char| '%)) - (BOOT-EQUAL (ELT |word| 1) (|char| '|x|))) - (RETURN 'T)) - ((BOOT-EQUAL (ELT |word| 0) (|char| '| |)) (RETURN 'T))))) + ((AND (BOOT-EQUAL (ELT |word| 0) #\%) + (BOOT-EQUAL (ELT |word| 1) #\x)) + (RETURN t)) + ((BOOT-EQUAL (ELT |word| 0) #\space) (RETURN t))))) (COND ((AND (consp |word|) (|member| (CAR |word|) |$msgdbListPrims|)) - 'T) - ('T nil))))))) + t) + (t nil))))))) ;noBlankAfterP word== ; INTP word => false @@ -558,22 +558,22 @@ (RETURN (COND ((integerp |word|) nil) - ((|member| |word| |$msgdbNoBlanksAfterGroup|) 'T) - ('T + ((|member| |word| |$msgdbNoBlanksAfterGroup|) t) + (t (COND ((AND (stringp |word|) (> (setq |s| (SIZE |word|)) 1)) (COND - ((AND (BOOT-EQUAL (ELT |word| 0) (|char| '%)) - (BOOT-EQUAL (ELT |word| 1) (|char| '|x|))) - (RETURN 'T)) - ((BOOT-EQUAL (ELT |word| (SPADDIFFERENCE |s| 1)) - (|char| '| |)) - (RETURN 'T))))) + ((AND (BOOT-EQUAL (ELT |word| 0) #\%) + (BOOT-EQUAL (ELT |word| 1) #\x)) + (RETURN t)) + ((BOOT-EQUAL (ELT |word| (- |s| 1)) + #\space) + (RETURN t))))) (COND ((AND (consp |word|) (|member| (CAR |word|) |$msgdbListPrims|)) - 'T) - ('T nil))))))) + t) + (t nil))))))) ;cleanUpSegmentedMsg msg == ; -- removes any junk like double blanks @@ -597,7 +597,7 @@ (RETURN (SEQ (COND ((NULL (consp |msg|)) |msg|) - ('T + (t (setq |blanks| (cons " " (cons '| | nil))) (setq |haveBlank| nil) @@ -618,8 +618,8 @@ (setq |msg1| (cons |x| |msg1|)) (setq |haveBlank| (COND - ((|member| |x| |blanks|) 'T) - ('T nil))))))) + ((|member| |x| |blanks|) t) + (t nil))))))) |msg1|)))))) ;operationLink name == @@ -704,7 +704,7 @@ (|sayKeyedMsg| |descKey| |descArgs|) (|sayMSG| " ") (DO ((G166441 |l| (CDR G166441)) (G166429 nil) - (|i| 1 (QSADD1 |i|))) + (|i| 1 (1+ |i|))) ((OR (ATOM G166441) (PROGN (SETQ G166429 (CAR G166441)) nil) (PROGN @@ -817,7 +817,7 @@ (PROGN (setq |ISTMP#1| (QCAR |msg|)) (AND (consp |ISTMP#1|) - (PROGN (setq |ce| (QCAR |ISTMP#1|)) 'T))) + (PROGN (setq |ce| (QCAR |ISTMP#1|)) t))) (|member| |ce| '(|%ce| "%ce" |%rj| "%rj"))) |msg|) (|$texFormatting| |msg|) @@ -825,31 +825,31 @@ (PROGN (setq |ISTMP#1| (QCAR |msg|)) (AND (consp |ISTMP#1|) - (PROGN (setq |ce| (QCAR |ISTMP#1|)) 'T))) + (PROGN (setq |ce| (QCAR |ISTMP#1|)) t))) (member |ce| '(|%ce| "%ce") :test #'equal)) |msg|) - ('T (setq |potentialMarg| 0) (setq |actualMarg| 0) + (t (setq |potentialMarg| 0) (setq |actualMarg| 0) (setq |off| (COND ((<= |offset| 0) "") - ('T + (t (|fillerSpaces| |offset| " ")))) (setq |off1| (COND ((<= |offset| 1) "") - ('T - (|fillerSpaces| (SPADDIFFERENCE |offset| 1) + (t + (|fillerSpaces| (- |offset| 1) " ")))) - (setq |firstLine| 'T) + (setq |firstLine| t) (COND ((consp |msg|) (setq |lnl| |offset|) (COND ((AND (consp |msg|) - (PROGN (setq |a| (QCAR |msg|)) 'T) + (PROGN (setq |a| (QCAR |msg|)) t) (|member| |a| '(| | " "))) (setq |nl| (cons |off1| nil)) - (setq |lnl| (SPADDIFFERENCE |lnl| 1))) - ('T (setq |nl| (cons |off| nil)))) + (setq |lnl| (- |lnl| 1))) + (t (setq |nl| (cons |off| nil)))) (DO ((G166564 |msg| (CDR G166564)) (|f| nil)) ((OR (ATOM G166564) (PROGN (SETQ |f| (CAR G166564)) nil)) @@ -879,7 +879,7 @@ (+ |potentialMarg| (CDR |f|))) (setq |nl| (cons |f| |nl|))) - ('T + (t (setq |sbl| (|sayBrightlyLength| |f|)) (setq |tot| @@ -911,17 +911,17 @@ |potentialMarg|) (setq |lnl| (+ - (+ (SPADDIFFERENCE 1) + (+ (- 1) |offset|) |sbl|))) - ('T + (t (setq |nl| (cons |f| (cons |off| (cons '|%l| |nl|)))) (setq |lnl| (+ |offset| |sbl|))))))))) (|concat| (NREVERSE |nl|))) - ('T (|concat| '|%l| |off| |msg|))))))))) + (t (|concat| '|%l| |off| |msg|))))))))) ;--% Other handy things ;keyedMsgCompFailure(key,args) == @@ -939,7 +939,7 @@ |$useCoerceOrCroak|)) (COND ((NULL |$useCoerceOrCroak|) (THROW '|coerceOrCroaker| '|croaked|)) - ('T + (t (COND ((AND (NULL |$Coerce|) |$reportInterpOnly|) (|sayKeyedMsg| |key| |args|) @@ -948,7 +948,7 @@ (COND ((NULL |$compilingMap|) (THROW '|loopCompiler| '|tryInterpOnly|)) - ('T (THROW '|mapCompiler| '|tryInterpOnly|)))))) + (t (THROW '|mapCompiler| '|tryInterpOnly|)))))) ;keyedMsgCompFailureSP(key,args,atree) == ; -- Called when compilation fails in such a way that interpret-code @@ -971,7 +971,7 @@ (COND ((NULL |$useCoerceOrCroak|) (THROW '|coerceOrCroaker| '|croaked|)) - ('T + (t (COND ((AND (NULL |$Coerce|) |$reportInterpOnly|) (COND @@ -984,7 +984,7 @@ (COND ((NULL |$compilingMap|) (THROW '|loopCompiler| '|tryInterpOnly|)) - ('T (THROW '|mapCompiler| '|tryInterpOnly|)))))))) + (t (THROW '|mapCompiler| '|tryInterpOnly|)))))))) ;throwKeyedMsgCannotCoerceWithValue(val,t1,t2) == ; null (val' := coerceInteractive(mkObj(val,t1),$OutputForm)) => @@ -1002,7 +1002,7 @@ |$OutputForm|))) (|throwKeyedMsg| "Cannot convert the value from type %1p to %2p ." (cons |t1| (cons |t2| nil)))) - ('T (setq |val'| (|objValUnwrap| |val'|)) + (t (setq |val'| (|objValUnwrap| |val'|)) (|throwKeyedMsg| "Cannot convert from type %1p to %2p for value %3m" (cons |t1| (cons |t2| (cons |val'| nil))))))))) @@ -1023,19 +1023,12 @@ ((AND |msg| (consp |msg|) (|member| (CAR |msg|) '(|%l| "%l")) (|member| (|last| |msg|) '(|%l| "%l"))) (|concat| |msg|)) - ('T (|concat| '|%l| |msg| '|%l|)))) + (t (|concat| '|%l| |msg| '|%l|)))) ;sayMessage msg == sayMSG mkMessage msg (defun |sayMessage| (|msg|) (|sayMSG| (|mkMessage| |msg|))) -;sayString x == -; -- Note: this function should *always* be used by sayBrightly and -; -- friends rather than PRINTEXP -- see bindSayBrightly -; PRINTEXP x - -(defun |sayString| (|x|) (PRINTEXP |x|)) - ;HELP() == sayKeyedMsg("S2GL0019",nil) ;;; *** HELP REDEFINED @@ -1114,29 +1107,29 @@ (RETURN (SEQ (COND (|$texFormatting| (|brightPrint0AsTeX| |x|)) - ('T (COND ((IDENTP |x|) (setq |x| (PNAME |x|)))) + (t (COND ((IDENTP |x|) (setq |x| (PNAME |x|)))) (COND ((AND (STRINGP |x|) (> (STRINGLENGTH |x|) 1) - (BOOT-EQUAL (ELT |x| 0) (|char| '|\\|)) - (BOOT-EQUAL (ELT |x| 1) (|char| '%))) - (|sayString| (SUBSTRING |x| 1 nil))) + (BOOT-EQUAL (ELT |x| 0) #\\) + (BOOT-EQUAL (ELT |x| 1) #\%)) + (princ (SUBSTRING |x| 1 nil))) ((BOOT-EQUAL |x| "%l") (terpri) - (DO ((|i| 1 (QSADD1 |i|))) + (DO ((|i| 1 (1+ |i|))) ((QSGREATERP |i| $MARG) nil) - (SEQ (EXIT (|sayString| " "))))) + (SEQ (EXIT (princ " "))))) ((BOOT-EQUAL |x| "%i") (setq $MARG (+ $MARG 3))) ((BOOT-EQUAL |x| "%u") - (setq $MARG (SPADDIFFERENCE $MARG 3)) - (COND ((MINUSP $MARG) (setq $MARG 0)) ('T nil))) + (setq $MARG (- $MARG 3)) + (COND ((MINUSP $MARG) (setq $MARG 0)) (t nil))) ((BOOT-EQUAL |x| "%U") (setq $MARG 0)) ((BOOT-EQUAL |x| "%") - (|sayString| " ")) + (princ " ")) ((BOOT-EQUAL |x| "%%") - (|sayString| "%")) + (princ "%")) ((setq |k| (|blankIndicator| |x|)) (BLANKS |k|)) - ((STRINGP |x|) (|sayString| |x|)) - ('T (|brightPrintHighlight| |x|))))))))) + ((STRINGP |x|) (princ |x|)) + (t (|brightPrintHighlight| |x|))))))))) ;brightPrint0AsTeX x == ; x = '"%l" => @@ -1171,32 +1164,32 @@ (RETURN (SEQ (COND ((BOOT-EQUAL |x| "%l") - (|sayString| "\\\\") - (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| $MARG) nil) - (SEQ (EXIT (|sayString| "\\ "))))) + (princ "\\\\") + (DO ((|i| 1 (1+ |i|))) ((QSGREATERP |i| $MARG) nil) + (SEQ (EXIT (princ "\\ "))))) ((BOOT-EQUAL |x| "%i") (setq $MARG (+ $MARG 3))) ((BOOT-EQUAL |x| "%u") - (setq $MARG (SPADDIFFERENCE $MARG 3)) - (COND ((MINUSP $MARG) (setq $MARG 0)) ('T nil))) + (setq $MARG (- $MARG 3)) + (COND ((MINUSP $MARG) (setq $MARG 0)) (t nil))) ((BOOT-EQUAL |x| "%U") (setq $MARG 0)) ((BOOT-EQUAL |x| "%") - (|sayString| "\\ ")) + (princ "\\ ")) ((BOOT-EQUAL |x| "%%") - (|sayString| "%")) + (princ "%")) ;TPD ((BOOT-EQUAL |x| "%b") -;TPD (|sayString| " {\\tt ")) +;TPD (princ " {\\tt ")) ((setq |k| (|blankIndicator| |x|)) - (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |k|) nil) - (SEQ (EXIT (|sayString| "\\ "))))) + (DO ((|i| 1 (1+ |i|))) ((QSGREATERP |i| |k|) nil) + (SEQ (EXIT (princ "\\ "))))) ;TPD ((BOOT-EQUAL |x| "%d") -;TPD (|sayString| "} ")) +;TPD (princ "} ")) ((BOOT-EQUAL |x| "\"$\"") - (|sayString| "\"\\verb!$!\"")) + (princ "\"\\verb!$!\"")) ((BOOT-EQUAL |x| "$") - (|sayString| "\\verb!$!")) - ((STRINGP |x|) (|sayString| |x|)) - ('T (|brightPrintHighlight| |x|))))))) + (princ "\\verb!$!")) + ((STRINGP |x|) (princ |x|)) + (t (|brightPrintHighlight| |x|))))))) ;blankIndicator x == ; if IDENTP x then x := PNAME x @@ -1214,8 +1207,8 @@ ((AND (BOOT-EQUAL (ELT |x| 0) '%) (BOOT-EQUAL (ELT |x| 1) '|x|)) (COND ((> (MAXINDEX |x|) 1) (PARSE-INTEGER (SUBSTRING |x| 2 nil))) - ('T 1))) - ('T nil)))) + (t 1))) + (t nil)))) ;brightPrint1 x == ; if x in '(%l "%l") then sayNewLine() @@ -1227,8 +1220,8 @@ (PROGN (COND ((|member| |x| '(|%l| "%l")) (terpri)) - ((STRINGP |x|) (|sayString| |x|)) - ('T (|brightPrintHighlight| |x|))) + ((STRINGP |x|) (princ |x|)) + (t (|brightPrintHighlight| |x|))) nil)) ;brightPrintHighlight x == @@ -1266,10 +1259,10 @@ (SEQ (COND (|$texFormatting| (|brightPrintHighlightAsTeX| |x|)) ((IDENTP |x|) (setq |pn| (PNAME |x|)) - (|sayString| |pn|)) - ((VECP |x|) (|sayString| "UNPRINTABLE")) - ((ATOM |x|) (|sayString| (|object2String| |x|))) - ('T (setq |key| (CAR |x|)) (setq |rst| (CDR |x|)) + (princ |pn|)) + ((VECP |x|) (princ |x|)) + ((ATOM |x|) (princ (|object2String| |x|))) + (t (setq |key| (CAR |x|)) (setq |rst| (CDR |x|)) (COND ((IDENTP |key|) (setq |key| (PNAME |key|)))) (COND ((BOOT-EQUAL |key| "%m") @@ -1281,7 +1274,7 @@ (|brightPrintRightJustify| |rst|)) ((BOOT-EQUAL |key| "%t") (setq $MARG (+ $MARG (|tabber| |rst|)))) - ('T (|sayString| "(") + (t (princ "(") (|brightPrint1| |key|) (COND ((EQ |key| '|TAGGEDreturn|) @@ -1296,13 +1289,13 @@ (PROGN (SETQ |y| (CAR G166741)) nil)) nil) (SEQ (EXIT (PROGN - (|sayString| " ") + (princ " ") (|brightPrint1| |y|))))) (COND ((AND |rst| (setq |la| (LASTATOM |rst|))) - (|sayString| " . ") + (princ " . ") (|brightPrint1| |la|))) - (|sayString| ")"))))))))) + (princ ")"))))))))) ;brightPrintHighlightAsTeX x == ; IDENTP x => @@ -1338,22 +1331,22 @@ (RETURN (SEQ (COND ((IDENTP |x|) (setq |pn| (PNAME |x|)) - (|sayString| |pn|)) - ((ATOM |x|) (|sayString| (|object2String| |x|))) - ((VECP |x|) (|sayString| "UNPRINTABLE")) - ('T (setq |key| (CAR |x|)) (setq |rst| (CDR |x|)) + (princ |pn|)) + ((ATOM |x|) (princ (|object2String| |x|))) + ((VECP |x|) (princ |x|)) + (t (setq |key| (CAR |x|)) (setq |rst| (CDR |x|)) (COND ((BOOT-EQUAL |key| "%m") (|mathprint| |rst|)) ((BOOT-EQUAL |key| "%m") |rst|) ((BOOT-EQUAL |key| "%s") - (|sayString| "\\verb_") - (PRETTYPRIN0 |rst|) (|sayString| "_")) + (princ "\\verb_") + (PRETTYPRIN0 |rst|) (princ "_")) ((BOOT-EQUAL |key| "%ce") (|brightPrintCenter| |rst|)) ((BOOT-EQUAL |key| "%t") (setq $MARG (+ $MARG (|tabber| |rst|)))) - ('T (|sayString| "(") + (t (princ "(") (|brightPrint1| |key|) (COND ((EQ |key| '|TAGGEDreturn|) @@ -1368,13 +1361,13 @@ (PROGN (SETQ |y| (CAR G166770)) nil)) nil) (SEQ (EXIT (PROGN - (|sayString| " ") + (princ " ") (|brightPrint1| |y|))))) (COND ((AND |rst| (setq |la| (LASTATOM |rst|))) - (|sayString| " . ") + (princ " . ") (|brightPrint1| |la|))) - (|sayString| ")"))))))))) + (princ ")"))))))))) ;tabber num == ; maxTab := 50 @@ -1386,7 +1379,7 @@ (RETURN (PROGN (setq |maxTab| 50) - (COND ((> |num| |maxTab|) |maxTab|) ('T |num|)))))) + (COND ((> |num| |maxTab|) |maxTab|) (t |num|)))))) ;brightPrintCenter x == ; $texFormatting => brightPrintCenterAsTeX x @@ -1427,7 +1420,7 @@ (COND ((> $LINELENGTH |wid|) (setq |f| - (DIVIDE (SPADDIFFERENCE $LINELENGTH |wid|) 2)) + (DIVIDE (- $LINELENGTH |wid|) 2)) (setq |x| (LIST (|fillerSpaces| (ELT |f| 0) " ") @@ -1438,20 +1431,20 @@ nil) (SEQ (EXIT (|brightPrint0| |y|)))) nil) - ('T (setq |y| nil) (setq |ok| 'T) + (t (setq |y| nil) (setq |ok| t) (DO () ((NULL (AND |x| |ok|)) nil) (SEQ (EXIT (PROGN (COND ((|member| (CAR |x|) '(|%l| "%l")) (setq |ok| nil)) - ('T (setq |y| (cons (CAR |x|) |y|)))) + (t (setq |y| (cons (CAR |x|) |y|)))) (setq |x| (CDR |x|)))))) (setq |y| (NREVERSE |y|)) (setq |wid| (|sayBrightlyLength| |y|)) (COND ((> $LINELENGTH |wid|) (setq |f| - (DIVIDE (SPADDIFFERENCE $LINELENGTH |wid|) 2)) + (DIVIDE (- $LINELENGTH |wid|) 2)) (setq |y| (cons (|fillerSpaces| (ELT |f| 0) " ") @@ -1487,9 +1480,9 @@ (PROG (|lst| |words|) (RETURN (SEQ (COND - ((ATOM |x|) (|sayString| "\\centerline{") - (|sayString| |x|) (|sayString| "}")) - ('T (setq |lst| |x|) + ((ATOM |x|) (princ "\\centerline{") + (princ |x|) (princ "}")) + (t (setq |lst| |x|) (DO () ((NULL |lst|) nil) (SEQ (EXIT (PROGN (setq |words| nil) @@ -1506,7 +1499,7 @@ (setq |lst| (CDR |lst|)))))) (COND (|lst| (setq |lst| (CDR |lst|)))) - (|sayString| "\\centerline{") + (princ "\\centerline{") (setq |words| (NREVERSE |words|)) (DO ((G166868 |words| (CDR G166868)) (|zz| nil)) @@ -1516,7 +1509,7 @@ nil)) nil) (SEQ (EXIT (|brightPrint0| |zz|)))) - (|sayString| "}"))))) + (princ "}"))))) nil)))))) ;brightPrintRightJustify x == @@ -1557,7 +1550,7 @@ ((> $LINELENGTH |wid|) (setq |x| (LIST (|fillerSpaces| - (SPADDIFFERENCE $LINELENGTH |wid|) + (- $LINELENGTH |wid|) " ") |x|)) (DO ((G166891 |x| (CDR G166891)) (|y| nil)) @@ -1566,14 +1559,14 @@ nil) (SEQ (EXIT (|brightPrint0| |y|)))) nil) - ('T (|brightPrint0| |x|) nil))) - ('T (setq |y| nil) (setq |ok| 'T) + (t (|brightPrint0| |x|) nil))) + (t (setq |y| nil) (setq |ok| t) (DO () ((NULL (AND |x| |ok|)) nil) (SEQ (EXIT (PROGN (COND ((|member| (CAR |x|) '(|%l| "%l")) (setq |ok| nil)) - ('T (setq |y| (cons (CAR |x|) |y|)))) + (t (setq |y| (cons (CAR |x|) |y|)))) (setq |x| (CDR |x|)))))) (setq |y| (NREVERSE |y|)) (setq |wid| (|sayBrightlyLength| |y|)) @@ -1581,7 +1574,7 @@ ((> $LINELENGTH |wid|) (setq |y| (cons (|fillerSpaces| - (SPADDIFFERENCE $LINELENGTH |wid|) + (- $LINELENGTH |wid|) " ") |y|)))) (DO ((G166908 |y| (CDR G166908)) (|z| nil)) @@ -1618,7 +1611,7 @@ (COND ((NULL |l|) 0) ((ATOM |l|) (|sayBrightlyLength1| |l|)) - ('T + (t (+ (|sayBrightlyLength1| (CAR |l|)) (|sayBrightlyLength| (CDR |l|)))))) @@ -1641,7 +1634,7 @@ (declare (special |$highlightAllowed|)) (COND ;TPD ((|member| |x| '("%b" "%d" |%b| |%d|)) -;TPD (COND ((NULL |$highlightAllowed|) 1) ('T 1))) +;TPD (COND ((NULL |$highlightAllowed|) 1) (t 1))) ((|member| |x| '("%l" |%l|)) 0) ((AND (STRINGP |x|) (> (STRINGLENGTH |x|) 2) (BOOT-EQUAL (ELT |x| 0) "%") @@ -1651,7 +1644,7 @@ ((IDENTP |x|) (STRINGLENGTH (PNAME |x|))) ((VECP |x|) (STRINGLENGTH "UNPRINTABLE")) ((ATOM |x|) (STRINGLENGTH (STRINGIMAGE |x|))) - ('T (+ 2 (|sayBrightlyLength| |x|))))) + (t (+ 2 (|sayBrightlyLength| |x|))))) ;sayAsManyPerLineAsPossible l == ; -- it is assumed that l is a list of strings @@ -1715,11 +1708,11 @@ nil) (SEQ (EXIT (|sayMSG| |a|)))) nil) - ('T (setq |w| (MIN (+ |m| 3) $LINELENGTH)) + (t (setq |w| (MIN (+ |m| 3) $LINELENGTH)) (setq |p| (QUOTIENT $LINELENGTH |w|)) (setq |n| (|#| |l|)) (setq |str| "") - (DO ((G166999 (SPADDIFFERENCE |n| 1)) - (|i| 0 (QSADD1 |i|))) + (DO ((G166999 (- |n| 1)) + (|i| 0 (1+ |i|))) ((QSGREATERP |i| G166999) nil) (SEQ (EXIT (PROGN (setq |LETTMP#1| |l|) @@ -1728,7 +1721,7 @@ (setq |str| (STRCONC |str| |c| (|fillerSpaces| - (SPADDIFFERENCE |w| + (- |w| (|#| |c|)) " "))) (COND @@ -1781,12 +1774,12 @@ (PROGN (setq |x| (QCAR |l|)) (setq |l'| (QCDR |l|)) - 'T)) + t)) (COND ((> |width| (|sayWidth| |x|)) (|say2Split| |l'| (cons |x| |short|) |long| |width|)) - ('T (|say2Split| |l'| |short| (cons |x| |long|) |width|)))) - ('T (cons (NREVERSE |short|) (cons (NREVERSE |long|) nil))))))) + (t (|say2Split| |l'| |short| (cons |x| |long|) |width|)))) + (t (cons (NREVERSE |short|) (cons (NREVERSE |long|) nil))))))) ;sayLongOperation x == ; sayWidth x > $LINELENGTH and (splitListOn(x,"if") is [front,back]) => @@ -1810,11 +1803,11 @@ (AND (consp |ISTMP#2|) (EQ (QCDR |ISTMP#2|) nil) (PROGN (setq |back| (QCAR |ISTMP#2|)) - 'T)))))) + t)))))) (|sayBrightly| |front|) (BLANKS (+ 6 (|#| (PNAME (ELT |front| 1))))) (|sayBrightly| |back|)) - ('T (|sayBrightly| |x|)))))) + (t (|sayBrightly| |x|)))))) ;splitListOn(x,key) == ; key in x => @@ -1834,7 +1827,7 @@ (setq |y| (cons (CAR |x|) |y|)) (setq |x| (CDR |x|)))))) (cons (NREVERSE |y|) (cons |x| nil))) - ('T nil)))))) + (t nil)))))) ;say2PerLineThatFit l == ; while l repeat @@ -1854,7 +1847,7 @@ (|sayBrightlyNT| (CAR |l|)) (|sayBrightlyNT| (|fillerSpaces| - (SPADDIFFERENCE (QUOTIENT $LINELENGTH 2) + (- (QUOTIENT $LINELENGTH 2) (|sayDisplayWidth| (CAR |l|))) " ")) (COND @@ -1862,14 +1855,7 @@ (|sayBrightlyNT| (CAR |l|)) (setq |l| (CDR |l|)) (|sayBrightly| "")) - ('T (|sayBrightly| ""))))))))) - -;sayDisplayStringWidth x == -; null x => 0 -; sayDisplayWidth x - -(defun |sayDisplayStringWidth| (|x|) - (COND ((NULL |x|) 0) ('T (|sayDisplayWidth| |x|)))) + (t (|sayBrightly| ""))))))))) ;sayDisplayWidth x == ; consp x => @@ -1907,7 +1893,7 @@ ((OR (BOOT-EQUAL |x| '%%) (BOOT-EQUAL |x| "%%")) 1) - ('T (|#| (|atom2String| |x|)))))))) + (t (|#| (|atom2String| |x|)))))))) ;sayWidth x == ; atom x => # atom2String x @@ -1921,7 +1907,7 @@ (RETURN (SEQ (COND ((ATOM |x|) (|#| (|atom2String| |x|))) - ('T + (t (PROG (G167143) (setq G167143 0) (RETURN @@ -1982,19 +1968,19 @@ ; null al => nil ; entryWidth name > wid => nil ; entryWidth CDAR al > wid => nil -; 'T +; t (defun |canFit2ndEntry| (|name| |al|) (PROG (|wid|) (declare (special $LINELENGTH)) (RETURN (PROGN - (setq |wid| (SPADDIFFERENCE (QUOTIENT $LINELENGTH 2) 10)) + (setq |wid| (- (QUOTIENT $LINELENGTH 2) 10)) (COND ((NULL |al|) nil) ((> (|#| (|atom2String| |name|)) |wid|) nil) ((> (|#| (|atom2String| (CDAR |al|))) |wid|) nil) - ('T 'T)))))) + (t t)))))) ;center(text,argList) == ; width := IFCAR argList or $LINELENGTH @@ -2023,21 +2009,21 @@ (setq |moreLines| (CDR |u|)) |u|)) (setq |wid| (|sayBrightlyLength| |text|)) (COND - ((>= |wid| (SPADDIFFERENCE |width| 2)) + ((>= |wid| (- |width| 2)) (|sayBrightly| |text|)) - ('T + (t (setq |f| - (DIVIDE (SPADDIFFERENCE - (SPADDIFFERENCE |width| |wid|) 2) + (DIVIDE (- + (- |width| |wid|) 2) 2)) (setq |fill1| "") - (DO ((G167248 (ELT |f| 0)) (|i| 1 (QSADD1 |i|))) + (DO ((G167248 (ELT |f| 0)) (|i| 1 (1+ |i|))) ((QSGREATERP |i| G167248) nil) (SEQ (EXIT (setq |fill1| (STRCONC |fillchar| |fill1|))))) (COND ((EQL (ELT |f| 1) 0) (setq |fill2| |fill1|)) - ('T (setq |fill2| (STRCONC |fillchar| |fill1|)))) + (t (setq |fill2| (STRCONC |fillchar| |fill1|)))) (|concat| |fill1| |text| |fill2|)))))))) ;splitSayBrightlyArgument u == diff --git a/src/interp/newfort.lisp.pamphlet b/src/interp/newfort.lisp.pamphlet index f4e3393..1636062 100644 --- a/src/interp/newfort.lisp.pamphlet +++ b/src/interp/newfort.lisp.pamphlet @@ -1045,7 +1045,7 @@ ;displayLines1 lines == ; for l in lines repeat -; PRINTEXP(l,$fortranOutputStream) +; PRINC(l,$fortranOutputStream) ; TERPRI($fortranOutputStream) (DEFUN |displayLines1| (|lines|) @@ -1055,7 +1055,7 @@ (PROGN (SETQ |l| (CAR G166579)) NIL)) NIL) (SEQ (EXIT (PROGN - (PRINTEXP |l| |$fortranOutputStream|) + (PRINC |l| |$fortranOutputStream|) (TERPRI |$fortranOutputStream|))))))) ;displayLines lines == diff --git a/src/interp/record.lisp.pamphlet b/src/interp/record.lisp.pamphlet index 942449c..35bfc90 100644 --- a/src/interp/record.lisp.pamphlet +++ b/src/interp/record.lisp.pamphlet @@ -421,7 +421,7 @@ ;-- stringPrefix?('")read ",line) => 'skip ; stringPrefix?('")r",line) => 'skip ; stringPrefix?('")undo )redo",line) => 'skip -; PRINTEXP(line, file) +; PRINC(line, file) ; TERPRI file ; SHUT file ; _/EDITFILE: fluid := '"/tmp/temp.input" @@ -446,7 +446,7 @@ ((|stringPrefix?| ")undo )redo" |line|) '|skip|) - ('T (PRINTEXP |line| |file|) + ('T (PRINC |line| |file|) (TERPRI |file|)))))) (SHUT |file|) (setq /EDITFILE "/tmp/temp.input") @@ -523,13 +523,13 @@ ; SHUT $htStream ; outStream := MAKE_-OUTSTREAM opathname ; for [pageName,:commands] in alist repeat -; PRINTEXP('"-- ",outStream) -; PRINTEXP(pageName,outStream) +; PRINC('"-- ",outStream) +; PRINC(pageName,outStream) ; TERPRI outStream -; PRINTEXP('")cl all",outStream) +; PRINC('")cl all",outStream) ; TERPRI outStream ; for x in commands repeat -; PRINTEXP(htCommandToInputLine x,outStream) +; PRINC(htCommandToInputLine x,outStream) ; TERPRI outStream ; TERPRI outStream ; SHUT outStream @@ -585,11 +585,11 @@ NIL)) NIL) (SEQ (EXIT (PROGN - (PRINTEXP "-- " + (PRINC "-- " |outStream|) - (PRINTEXP |pageName| |outStream|) + (PRINC |pageName| |outStream|) (TERPRI |outStream|) - (PRINTEXP ")cl all" + (PRINC ")cl all" |outStream|) (TERPRI |outStream|) (DO ((G166374 |commands| @@ -602,7 +602,7 @@ NIL) (SEQ (EXIT (PROGN - (PRINTEXP + (PRINC (|htCommandToInputLine| |x|) |outStream|) (TERPRI |outStream|))))) diff --git a/src/interp/sys-pkg.lisp.pamphlet b/src/interp/sys-pkg.lisp.pamphlet index 9ff5ff2..92d8b36 100644 --- a/src/interp/sys-pkg.lisp.pamphlet +++ b/src/interp/sys-pkg.lisp.pamphlet @@ -431,7 +431,7 @@ provides support for compiler code. VMLISP::SUBRP VMLISP::ASSEMBLE VMLISP::|LAM,EVALANDFILEACTQ| VMLISP::|$msgDatabaseName| VMLISP::IFCDR VMLISP::QVMAXINDEX VMLISP::$SPADROOT VMLISP::PRIN0 VMLISP::PRETTYPRIN0 - VMLISP::STACKLIFO VMLISP::ASSQ VMLISP::PRINTEXP + VMLISP::STACKLIFO VMLISP::ASSQ VMLISP::QCDDDDR VMLISP::QSADD1 VMLISP::SETDIFFERENCEQ VMLISP::STRPOS VMLISP::CONSTANT VMLISP::QCAAR VMLISP::HCOUNT VMLISP::RCOPYITEMS @@ -622,7 +622,6 @@ provides support for compiler code. (lisp:import '(vmlisp::pname)) (lisp:import '(vmlisp::prettyprin0)) (lisp:import '(vmlisp::prettyprint)) -(lisp:import '(vmlisp::printexp)) (lisp:import '(vmlisp::qassq)) (lisp:import '(vmlisp::qcar)) (lisp:import '(vmlisp::qfirst)) diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index 4d58526..4eeb0e1 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -1117,7 +1117,6 @@ and works properly. \begin{chunk}{*} (define-function 'stringimage #'princ-to-string) -(define-function 'printexp #'princ) (define-function 'prin0 #'prin1) (defun |F,PRINT-ONE| (form &optional (stream *standard-output*)) -- 1.7.5.4