diff --git a/changelog b/changelog index 9556f1f..6c804ab 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +20091003 tpd src/axiom-website/patches.html 20091003.03.tpd.patch +20091003 tpd src/interp/i-output.lisp cleanup 20091003 tpd src/axiom-website/patches.html 20091003.02.tpd.patch 20091003 tpd src/interp/i-resolv.lisp cleanup 20091003 tpd src/axiom-website/patches.html 20091003.01.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index bee3ab8..c1d42d1 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2091,5 +2091,7 @@ src/interp/i-spec2.lisp cleanup
src/interp/i-spec1.lisp cleanup
20091003.02.tpd.patch src/interp/i-resolv.lisp cleanup
+20091003.03.tpd.patch +src/interp/i-output.lisp cleanup
diff --git a/src/interp/i-output.lisp.pamphlet b/src/interp/i-output.lisp.pamphlet index f7c03a9..7ebf473 100644 --- a/src/interp/i-output.lisp.pamphlet +++ b/src/interp/i-output.lisp.pamphlet @@ -30,62 +30,60 @@ ; ELT($specialCharacters,code) (DEFUN |specialChar| (|symbol|) - (PROG (|code|) - (RETURN - (COND - ((NULL (SPADLET |code| (IFCDR (ASSQ |symbol| |$specialCharacterAlist|)))) - (MAKESTRING "?")) - ((QUOTE T) - (ELT |$specialCharacters| |code|)))))) - + (PROG (|code|) + (DECLARE (SPECIAL |$specialCharacters| |$specialCharacterAlist|)) + (RETURN + (COND + ((NULL (SPADLET |code| + (IFCDR (ASSQ |symbol| |$specialCharacterAlist|)))) + (MAKESTRING "?")) + ('T (ELT |$specialCharacters| |code|)))))) ;rbrkSch() == PNAME specialChar 'rbrk -(DEFUN |rbrkSch| NIL (PNAME (|specialChar| (QUOTE |rbrk|)))) +(DEFUN |rbrkSch| () (PNAME (|specialChar| '|rbrk|))) ;lbrkSch() == PNAME specialChar 'lbrk -(DEFUN |lbrkSch| NIL (PNAME (|specialChar| (QUOTE |lbrk|)))) +(DEFUN |lbrkSch| () (PNAME (|specialChar| '|lbrk|))) ;quadSch() == PNAME specialChar 'quad -(DEFUN |quadSch| NIL (PNAME (|specialChar| (QUOTE |quad|)))) +(DEFUN |quadSch| () (PNAME (|specialChar| '|quad|))) ;isBinaryInfix x == ; x in '(_= _+ _- _* _/ _*_* _^ "=" "+" "-" "*" "/" "**" "^") (DEFUN |isBinaryInfix| (|x|) - (|member| |x| (QUOTE (= + - * / ** ^ "=" "+" "-" "*" "/" "**" "^")))) + (|member| |x| '(= + - * / ** ^ "=" "+" "-" "*" "/" "**" "^"))) ;stringApp([.,u],x,y,d) == ; appChar(STRCONC($DoubleQuote,atom2String u,$DoubleQuote),x,y,d) -(DEFUN |stringApp| (#0=#:G166074 |x| |y| |d|) - (PROG (|u|) - (RETURN - (PROGN - (SPADLET |u| (CADR #0#)) - (|appChar| - (STRCONC |$DoubleQuote| (|atom2String| |u|) |$DoubleQuote|) - |x| |y| |d|))))) +(DEFUN |stringApp| (G166074 |x| |y| |d|) + (PROG (|u|) + (DECLARE (SPECIAL |$DoubleQuote|)) + (RETURN + (PROGN + (SPADLET |u| (CADR G166074)) + (|appChar| + (STRCONC |$DoubleQuote| (|atom2String| |u|) |$DoubleQuote|) + |x| |y| |d|))))) ;stringWidth u == ; u is [.,u] or THROW('outputFailure,'outputFailure) ; 2+#u (DEFUN |stringWidth| (|u|) - (PROG (|ISTMP#1|) - (RETURN - (PROGN - (OR - (AND (PAIRP |u|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |u|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |u| (QCAR |ISTMP#1|)) (QUOTE T))))) - (THROW (QUOTE |outputFailure|) (QUOTE |outputFailure|))) - (PLUS 2 (|#| |u|)))))) + (PROG (|ISTMP#1|) + (RETURN + (PROGN + (OR (AND (PAIRP |u|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |u|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |u| (QCAR |ISTMP#1|)) 'T)))) + (THROW '|outputFailure| '|outputFailure|)) + (PLUS 2 (|#| |u|)))))) ;obj2String o == ; atom o => @@ -97,28 +95,31 @@ ; APPLY('STRCONC,[obj2String o' for o' in o]) (DEFUN |obj2String| (|o|) - (PROG NIL - (RETURN - (SEQ - (COND - ((ATOM |o|) - (COND - ((STRINGP |o|) |o|) - ((BOOT-EQUAL |o| (QUOTE | |)) (MAKESTRING " ")) - ((BOOT-EQUAL |o| (QUOTE |)|)) - (MAKESTRING ")")) - ((BOOT-EQUAL |o| (QUOTE |(|)) (MAKESTRING "(")) - ((QUOTE T) (STRINGIMAGE |o|)))) - ((QUOTE T) - (APPLY - (QUOTE STRCONC) - (PROG (#0=#:G166101) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166106 |o| (CDR #1#)) (|o'| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |o'| (CAR #1#)) NIL)) - (NREVERSE0 #0#)) - (SEQ (EXIT (SETQ #0# (CONS (|obj2String| |o'|) #0#)))))))))))))) + (PROG () + (RETURN + (SEQ (COND + ((ATOM |o|) + (COND + ((STRINGP |o|) |o|) + ((BOOT-EQUAL |o| '| |) (MAKESTRING " ")) + ((BOOT-EQUAL |o| '|)|) (MAKESTRING ")")) + ((BOOT-EQUAL |o| '|(|) (MAKESTRING "(")) + ('T (STRINGIMAGE |o|)))) + ('T + (APPLY 'STRCONC + (PROG (G166101) + (SPADLET G166101 NIL) + (RETURN + (DO ((G166106 |o| (CDR G166106)) + (|o'| NIL)) + ((OR (ATOM G166106) + (PROGN + (SETQ |o'| (CAR G166106)) + NIL)) + (NREVERSE0 G166101)) + (SEQ (EXIT (SETQ G166101 + (CONS (|obj2String| |o'|) + G166101)))))))))))))) ;APP(u,x,y,d) == ; atom u => appChar(atom2String u,x,y,d) @@ -173,10 +174,10 @@ ; stringer x (DEFUN |atom2String| (|x|) - (COND - ((IDENTP |x|) (PNAME |x|)) - ((STRINGP |x|) |x|) - ((QUOTE T) (|stringer| |x|)))) + (COND + ((IDENTP |x|) (PNAME |x|)) + ((STRINGP |x|) |x|) + ('T (|stringer| |x|)))) @ \begin{verbatim} @@ -212,40 +213,44 @@ these functions return an updated ``layout so far'' in general ; appChar(string,x,y,nconc(d,[[y,:GETFULLSTR(10+$LINELENGTH+$MARGIN," ")]])) (DEFUN |appChar| (|string| |x| |y| |d|) - (PROG (|line| |bumpDeltaIfTrue| |shiftedX| |n|) - (RETURN - (PROGN - (COND ((CHARP |string|) (SPADLET |string| (PNAME |string|)))) - (COND - ((SPADLET |line| (LASSOC |y| |d|)) - (COND - ((AND - (EQL (MAXINDEX |string|) 1) - (BOOT-EQUAL (|char| (ELT |string| 0)) (QUOTE %))) + (PROG (|line| |bumpDeltaIfTrue| |shiftedX| |n|) + (DECLARE (SPECIAL $LINELENGTH $MARGIN |$highlightDelta|)) + (RETURN + (PROGN + (COND ((CHARP |string|) (SPADLET |string| (PNAME |string|)))) (COND - ((BOOT-EQUAL (ELT |string| 1) (QUOTE |b|)) - (SPADLET |bumpDeltaIfTrue| (QUOTE T)) - (SETELT |string| 0 (EBCDIC 29)) - (SETELT |string| 1 (EBCDIC 200))) - ((BOOT-EQUAL (ELT |string| 1) (QUOTE |d|)) - (SPADLET |bumpDeltaIfTrue| (QUOTE T)) - (SETELT |string| 0 (EBCDIC 29)) - (SETELT |string| 1 (EBCDIC 65)))))) - (SPADLET |shiftedX| - (COND - ((EQL |y| 0) (PLUS |x| |$highlightDelta|)) - ((QUOTE T) |x|))) - (RPLACSTR |line| |shiftedX| (SPADLET |n| (|#| |string|)) |string| 0 |n|) - (COND - ((BOOT-EQUAL |bumpDeltaIfTrue| (QUOTE T)) - (SPADLET |$highlightDelta| (PLUS |$highlightDelta| 1)))) |d|) - ((QUOTE T) - (|appChar| |string| |x| |y| - (NCONC |d| - (CONS - (CONS |y| - (GETFULLSTR (PLUS (PLUS 10 $LINELENGTH) $MARGIN) (QUOTE | |))) - NIL))))))))) + ((SPADLET |line| (LASSOC |y| |d|)) + (COND + ((AND (EQL (MAXINDEX |string|) 1) + (BOOT-EQUAL (|char| (ELT |string| 0)) '%)) + (COND + ((BOOT-EQUAL (ELT |string| 1) '|b|) + (SPADLET |bumpDeltaIfTrue| 'T) + (SETELT |string| 0 (EBCDIC 29)) + (SETELT |string| 1 (EBCDIC 200))) + ((BOOT-EQUAL (ELT |string| 1) '|d|) + (SPADLET |bumpDeltaIfTrue| 'T) + (SETELT |string| 0 (EBCDIC 29)) + (SETELT |string| 1 (EBCDIC 65)))))) + (SPADLET |shiftedX| + (COND + ((EQL |y| 0) (PLUS |x| |$highlightDelta|)) + ('T |x|))) + (RPLACSTR |line| |shiftedX| (SPADLET |n| (|#| |string|)) + |string| 0 |n|) + (COND + ((BOOT-EQUAL |bumpDeltaIfTrue| 'T) + (SPADLET |$highlightDelta| (PLUS |$highlightDelta| 1)))) + |d|) + ('T + (|appChar| |string| |x| |y| + (NCONC |d| + (CONS (CONS |y| + (GETFULLSTR + (PLUS (PLUS 10 $LINELENGTH) + $MARGIN) + '| |)) + NIL))))))))) ;print(x,domain) == ; dom:= devaluate domain @@ -254,14 +259,14 @@ these functions return an updated ``layout so far'' in general ; output(x,dom) (DEFUN |print| (|x| |domain|) - (PROG (|$InteractiveMode| |$dontDisplayEquatnum| |dom|) - (DECLARE (SPECIAL |$InteractiveMode| |$dontDisplayEquatnum|)) - (RETURN - (PROGN - (SPADLET |dom| (|devaluate| |domain|)) - (SPADLET |$InteractiveMode| (QUOTE T)) - (SPADLET |$dontDisplayEquatnum| (QUOTE T)) - (|output| |x| |dom|))))) + (PROG (|$InteractiveMode| |$dontDisplayEquatnum| |dom|) + (DECLARE (SPECIAL |$InteractiveMode| |$dontDisplayEquatnum|)) + (RETURN + (PROGN + (SPADLET |dom| (|devaluate| |domain|)) + (SPADLET |$InteractiveMode| 'T) + (SPADLET |$dontDisplayEquatnum| 'T) + (|output| |x| |dom|))))) ;mathprintWithNumber x == ; x:= outputTran x @@ -270,12 +275,13 @@ these functions return an updated ``layout so far'' in general ; x (DEFUN |mathprintWithNumber| (|x|) - (PROGN - (SPADLET |x| (|outputTran| |x|)) - (|maprin| - (COND - (|$IOindex| (CONS (QUOTE EQUATNUM) (CONS |$IOindex| (CONS |x| NIL)))) - ((QUOTE T) |x|))))) + (DECLARE (SPECIAL |$IOindex|)) + (PROGN + (SPADLET |x| (|outputTran| |x|)) + (|maprin| (COND + (|$IOindex| + (CONS 'EQUATNUM (CONS |$IOindex| (CONS |x| NIL)))) + ('T |x|))))) ;mathprint x == ; x := outputTran x @@ -283,23 +289,28 @@ these functions return an updated ``layout so far'' in general ; maprin x (DEFUN |mathprint| (|x|) - (PROGN - (SPADLET |x| (|outputTran| |x|)) - (COND (|$saturn| (|texFormat1| |x|)) ((QUOTE T) (|maprin| |x|))))) + (DECLARE (SPECIAL |$saturn|)) + (PROGN + (SPADLET |x| (|outputTran| |x|)) + (COND (|$saturn| (|texFormat1| |x|)) ('T (|maprin| |x|))))) + ;sayMath u == ; for x in u repeat acc:= concat(acc,linearFormatName x) ; sayALGEBRA acc (DEFUN |sayMath| (|u|) - (PROG (|acc|) - (RETURN - (SEQ - (PROGN - (DO ((#0=#:G166189 |u| (CDR #0#)) (|x| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) - (SEQ (EXIT (SPADLET |acc| (|concat| |acc| (|linearFormatName| |x|)))))) - (|sayALGEBRA| |acc|)))))) + (PROG (|acc|) + (RETURN + (SEQ (PROGN + (DO ((G166189 |u| (CDR G166189)) (|x| NIL)) + ((OR (ATOM G166189) + (PROGN (SETQ |x| (CAR G166189)) NIL)) + NIL) + (SEQ (EXIT (SPADLET |acc| + (|concat| |acc| + (|linearFormatName| |x|)))))) + (|sayALGEBRA| |acc|)))))) ;--% Output transformations ;outputTran x == @@ -433,6 +444,9 @@ these functions return an updated ``layout so far'' in general |LETTMP#1| |a'| |b'| |fun| |targ| |targ'| |c| |foo1| |op'| |foo2| |foo3| |foo4| |l| |ll| |op| |a| |b| |ISTMP#1| |u| |ISTMP#2| |pred|) + (DECLARE (SPECIAL |$fractionDisplayType| |$InteractiveMode| + |$Integer| |$PositiveInteger| |$DoubleFloat| + |$EmptyMode|)) (RETURN (SEQ (COND ((|member| |x| '("failed" "nil" "prime" "sqfr" "irred")) @@ -1085,7 +1099,6 @@ these functions return an updated ``layout so far'' in general (|mkSuperSub| |op| |l|)) ('T (CONS (|outputTran| |op|) |l|))))))))))) - @ The next two functions are designed to replace successive instances of binary functions with the n-ary equivalent, cutting down on recursion @@ -1099,16 +1112,16 @@ without stack overflow. MCD. ; l (DEFUN |flattenOps| (|l|) - (PROG (|op| |args|) - (RETURN - (PROGN - (SPADLET |op| (CAR |l|)) - (SPADLET |args| (CDR |l|)) - (COND - ((|member| |op| - (CONS "+" (CONS "*" (CONS (QUOTE +) (CONS (QUOTE *) NIL))))) - (CONS |op| (|checkArgs| |op| |args|))) - ((QUOTE T) |l|)))))) + (PROG (|op| |args|) + (RETURN + (PROGN + (SPADLET |op| (CAR |l|)) + (SPADLET |args| (CDR |l|)) + (COND + ((|member| |op| + (CONS "+" (CONS "*" (CONS '+ (CONS '* NIL))))) + (CONS |op| (|checkArgs| |op| |args|))) + ('T |l|)))))) ;checkArgs(op,tail) == ; head := [] @@ -1127,30 +1140,27 @@ without stack overflow. MCD. ; REVERSE head (DEFUN |checkArgs| (|op| |tail|) - (PROG (|term| |head|) - (RETURN - (SEQ - (PROGN - (SPADLET |head| NIL) - (DO () - ((NULL |tail|) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |term| (CAR |tail|)) - (COND - ((ATOM |term|) - (SPADLET |head| (CONS |term| |head|)) - (SPADLET |tail| (CDR |tail|))) - ((NULL (LISTP |term|)) - (SPADLET |head| (CONS |term| |head|)) - (SPADLET |tail| (CDR |tail|))) - ((BOOT-EQUAL |op| (CAR |term|)) - (SPADLET |tail| (APPEND (CDR |term|) (CDR |tail|)))) - ((QUOTE T) - (SPADLET |head| (CONS |term| |head|)) - (SPADLET |tail| (CDR |tail|)))))))) - (REVERSE |head|)))))) + (PROG (|term| |head|) + (RETURN + (SEQ (PROGN + (SPADLET |head| NIL) + (DO () ((NULL |tail|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |term| (CAR |tail|)) + (COND + ((ATOM |term|) + (SPADLET |head| (CONS |term| |head|)) + (SPADLET |tail| (CDR |tail|))) + ((NULL (LISTP |term|)) + (SPADLET |head| (CONS |term| |head|)) + (SPADLET |tail| (CDR |tail|))) + ((BOOT-EQUAL |op| (CAR |term|)) + (SPADLET |tail| + (APPEND (CDR |term|) + (CDR |tail|)))) + ('T (SPADLET |head| (CONS |term| |head|)) + (SPADLET |tail| (CDR |tail|)))))))) + (REVERSE |head|)))))) ;; REVERSIP head @@ -1164,36 +1174,42 @@ NIL ; if exitform is ['exit,.,a] then exitform := a ; ['SC,:[outputTran x for x in l],outputTran exitform] -(DEFUN |outputTranSEQ| (#0=G166882) - (PROG (|LETTMP#1| |l| |ISTMP#1| |ISTMP#2| |a| |exitform|) - (RETURN - (SEQ - (PROGN - (SPADLET |LETTMP#1| (REVERSE (CDR #0#))) - (SPADLET |exitform| (CAR |LETTMP#1|)) - (SPADLET |l| (NREVERSE (CDR |LETTMP#1|))) - (COND - ((AND (PAIRP |exitform|) - (EQ (QCAR |exitform|) (QUOTE |exit|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |exitform|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |a| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (SPADLET |exitform| |a|))) - (CONS (QUOTE SC) - (APPEND - (PROG (#1=G166903) - (SPADLET #1# NIL) - (RETURN - (DO ((#2=G166908 |l| (CDR #2#)) (|x| NIL)) - ((OR (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) (NREVERSE0 #1#)) - (SEQ (EXIT (SETQ #1# (CONS (|outputTran| |x|) #1#))))))) - (CONS (|outputTran| |exitform|) NIL)))))))) +(DEFUN |outputTranSEQ| (G166882) + (PROG (|LETTMP#1| |l| |ISTMP#1| |ISTMP#2| |a| |exitform|) + (RETURN + (SEQ (PROGN + (SPADLET |LETTMP#1| (REVERSE (CDR G166882))) + (SPADLET |exitform| (CAR |LETTMP#1|)) + (SPADLET |l| (NREVERSE (CDR |LETTMP#1|))) + (COND + ((AND (PAIRP |exitform|) (EQ (QCAR |exitform|) '|exit|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |exitform|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |a| (QCAR |ISTMP#2|)) + 'T)))))) + (SPADLET |exitform| |a|))) + (CONS 'SC + (APPEND (PROG (G166903) + (SPADLET G166903 NIL) + (RETURN + (DO ((G166908 |l| (CDR G166908)) + (|x| NIL)) + ((OR (ATOM G166908) + (PROGN + (SETQ |x| (CAR G166908)) + NIL)) + (NREVERSE0 G166903)) + (SEQ (EXIT + (SETQ G166903 + (CONS (|outputTran| |x|) + G166903))))))) + (CONS (|outputTran| |exitform|) NIL)))))))) ;outputTranIf ['IF,x,y,z] == ; y = 'noBranch => @@ -1209,42 +1225,42 @@ NIL ; ['CONCATB,'if,outputTran x, ; ['SC,['CONCATB,'then,y'],['CONCATB,'else,z']]] -(DEFUN |outputTranIf| (#0=G166926) - (PROG (|x| |y| |z| |y'| |z'|) - (RETURN - (PROGN - (SPADLET |x| (CADR #0#)) - (SPADLET |y| (CADDR #0#)) - (SPADLET |z| (CADDDR #0#)) - (COND - ((BOOT-EQUAL |y| (QUOTE |noBranch|)) - (CONS (QUOTE CONCATB) - (CONS (QUOTE |if|) - (CONS - (CONS (QUOTE CONCATB) - (CONS (QUOTE |not|) (CONS (|outputTran| |x|) NIL))) - (CONS (QUOTE |then|) - (CONS (|outputTran| |z|) NIL)))))) - ((BOOT-EQUAL |z| (QUOTE |noBranch|)) - (CONS (QUOTE CONCATB) - (CONS (QUOTE |if|) - (CONS - (|outputTran| |x|) - (CONS (QUOTE |then|) (CONS (|outputTran| |y|) NIL)))))) - ((QUOTE T) - (SPADLET |y'| (|outputTran| |y|)) - (SPADLET |z'| (|outputTran| |z|)) - (CONS (QUOTE CONCATB) - (CONS (QUOTE |if|) - (CONS (|outputTran| |x|) - (CONS - (CONS (QUOTE SC) - (CONS - (CONS (QUOTE CONCATB) (CONS (QUOTE |then|) (CONS |y'| NIL))) - (CONS - (CONS (QUOTE CONCATB) (CONS (QUOTE |else|) (CONS |z'| NIL))) - NIL))) - NIL)))))))))) +(DEFUN |outputTranIf| (G166926) + (PROG (|x| |y| |z| |y'| |z'|) + (RETURN + (PROGN + (SPADLET |x| (CADR G166926)) + (SPADLET |y| (CADDR G166926)) + (SPADLET |z| (CADDDR G166926)) + (COND + ((BOOT-EQUAL |y| '|noBranch|) + (CONS 'CONCATB + (CONS '|if| + (CONS (CONS 'CONCATB + (CONS '|not| + (CONS (|outputTran| |x|) NIL))) + (CONS '|then| + (CONS (|outputTran| |z|) NIL)))))) + ((BOOT-EQUAL |z| '|noBranch|) + (CONS 'CONCATB + (CONS '|if| + (CONS (|outputTran| |x|) + (CONS '|then| + (CONS (|outputTran| |y|) NIL)))))) + ('T (SPADLET |y'| (|outputTran| |y|)) + (SPADLET |z'| (|outputTran| |z|)) + (CONS 'CONCATB + (CONS '|if| + (CONS (|outputTran| |x|) + (CONS (CONS 'SC + (CONS + (CONS 'CONCATB + (CONS '|then| (CONS |y'| NIL))) + (CONS + (CONS 'CONCATB + (CONS '|else| (CONS |z'| NIL))) + NIL))) + NIL)))))))))) ;outputMapTran l == ; null l => NIL -- should not happen @@ -1257,29 +1273,32 @@ NIL ; outputMapTran0(first l,alias) (DEFUN |outputMapTran| (|l|) - (PROG (|$linearFormatScripts| |alias|) - (DECLARE (SPECIAL |$linearFormatScripts|)) - (RETURN - (SEQ - (COND - ((NULL |l|) NIL) - ((QUOTE T) - (SPADLET |$linearFormatScripts| (QUOTE T)) - (SPADLET |alias| (|get| |$op| (QUOTE |alias|) |$InteractiveFrame|)) - (COND - ((CDR |l|) - (CONS (QUOTE SC) - (PROG (#0=G166950) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=G166955 |l| (CDR #1#)) (|ll| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |ll| (CAR #1#)) NIL)) - (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# (CONS (|outputMapTran0| |ll| |alias|) #0#))))))))) - ((QUOTE T) - (|outputMapTran0| (CAR |l|) |alias|))))))))) + (PROG (|$linearFormatScripts| |alias|) + (DECLARE (SPECIAL |$linearFormatScripts| |$InteractiveFrame| |$op|)) + (RETURN + (SEQ (COND + ((NULL |l|) NIL) + ('T (SPADLET |$linearFormatScripts| 'T) + (SPADLET |alias| + (|get| |$op| '|alias| |$InteractiveFrame|)) + (COND + ((CDR |l|) + (CONS 'SC + (PROG (G166950) + (SPADLET G166950 NIL) + (RETURN + (DO ((G166955 |l| (CDR G166955)) (|ll| NIL)) + ((OR (ATOM G166955) + (PROGN + (SETQ |ll| (CAR G166955)) + NIL)) + (NREVERSE0 G166950)) + (SEQ (EXIT (SETQ G166950 + (CONS + (|outputMapTran0| |ll| + |alias|) + G166950))))))))) + ('T (|outputMapTran0| (CAR |l|) |alias|))))))))) ;outputMapTran0(argDef,alias) == ; arg := first argDef @@ -1290,33 +1309,33 @@ NIL ; ['CONCATB,$op,outputTran arg',"==",outputTran def'] (DEFUN |outputMapTran0| (|argDef| |alias|) - (PROG (|arg| |def| |LETTMP#1| |def'| |arg'|) - (RETURN - (PROGN - (SPADLET |arg| (CAR |argDef|)) - (SPADLET |def| (CDR |argDef|)) - (SPADLET |LETTMP#1| (|simplifyMapPattern| |argDef| |alias|)) - (SPADLET |arg'| (CAR |LETTMP#1|)) - (SPADLET |def'| (CDR |LETTMP#1|)) - (SPADLET |arg'| (|outputTran| |arg'|)) - (COND ((NULL |arg'|) (SPADLET |arg'| (MAKESTRING "()")))) - (CONS (QUOTE CONCATB) - (CONS |$op| - (CONS - (|outputTran| |arg'|) - (CONS (QUOTE ==) (CONS (|outputTran| |def'|) NIL))))))))) + (PROG (|arg| |def| |LETTMP#1| |def'| |arg'|) + (DECLARE (SPECIAL |$op|)) + (RETURN + (PROGN + (SPADLET |arg| (CAR |argDef|)) + (SPADLET |def| (CDR |argDef|)) + (SPADLET |LETTMP#1| (|simplifyMapPattern| |argDef| |alias|)) + (SPADLET |arg'| (CAR |LETTMP#1|)) + (SPADLET |def'| (CDR |LETTMP#1|)) + (SPADLET |arg'| (|outputTran| |arg'|)) + (COND ((NULL |arg'|) (SPADLET |arg'| (MAKESTRING "()")))) + (CONS 'CONCATB + (CONS |$op| + (CONS (|outputTran| |arg'|) + (CONS '== (CONS (|outputTran| |def'|) NIL))))))))) ;outputTranReduce ['REDUCE,op,.,body] == ; ['CONCAT,op,"/",outputTran body] -(DEFUN |outputTranReduce| (#0=G166987) - (PROG (|op| |body|) - (RETURN - (PROGN - (SPADLET |op| (CADR #0#)) - (SPADLET |body| (CADDDR #0#)) - (CONS (QUOTE CONCAT) - (CONS |op| (CONS (QUOTE /) (CONS (|outputTran| |body|) NIL)))))))) +(DEFUN |outputTranReduce| (G166987) + (PROG (|op| |body|) + (RETURN + (PROGN + (SPADLET |op| (CADR G166987)) + (SPADLET |body| (CADDDR G166987)) + (CONS 'CONCAT + (CONS |op| (CONS '/ (CONS (|outputTran| |body|) NIL)))))))) ;outputTranRepeat ["REPEAT",:itl,body] == ; body' := outputTran body @@ -1325,52 +1344,51 @@ NIL ; ['CONCATB,itlist,'repeat,body'] ; ['CONCATB,'repeat,body'] -(DEFUN |outputTranRepeat| (#0=G167003) - (PROG (|LETTMP#1| |body| |itl| |body'| |itlist|) - (RETURN - (PROGN - (COND ((EQ (CAR #0#) (QUOTE REPEAT)) (CAR #0#))) - (SPADLET |LETTMP#1| (REVERSE (CDR #0#))) - (SPADLET |body| (CAR |LETTMP#1|)) - (SPADLET |itl| (NREVERSE (CDR |LETTMP#1|))) - (SPADLET |body'| (|outputTran| |body|)) - (COND - (|itl| - (SPADLET |itlist| (|outputTranIteration| |itl|)) - (CONS (QUOTE CONCATB) - (CONS |itlist| (CONS (QUOTE |repeat|) (CONS |body'| NIL))))) - ((QUOTE T) - (CONS (QUOTE CONCATB) (CONS (QUOTE |repeat|) (CONS |body'| NIL))))))))) +(DEFUN |outputTranRepeat| (G167003) + (PROG (|LETTMP#1| |body| |itl| |body'| |itlist|) + (RETURN + (PROGN + (COND ((EQ (CAR G167003) 'REPEAT) (CAR G167003))) + (SPADLET |LETTMP#1| (REVERSE (CDR G167003))) + (SPADLET |body| (CAR |LETTMP#1|)) + (SPADLET |itl| (NREVERSE (CDR |LETTMP#1|))) + (SPADLET |body'| (|outputTran| |body|)) + (COND + (|itl| (SPADLET |itlist| (|outputTranIteration| |itl|)) + (CONS 'CONCATB + (CONS |itlist| + (CONS '|repeat| (CONS |body'| NIL))))) + ('T (CONS 'CONCATB (CONS '|repeat| (CONS |body'| NIL))))))))) ;outputTranCollect [.,:itl,body] == ; itlist:= outputTranIteration itl ; ['BRACKET,['CONCATB,outputTran body,itlist]] -(DEFUN |outputTranCollect| (#0=G167025) - (PROG (|LETTMP#1| |body| |itl| |itlist|) - (RETURN - (PROGN - (SPADLET |LETTMP#1| (REVERSE (CDR #0#))) - (SPADLET |body| (CAR |LETTMP#1|)) - (SPADLET |itl| (NREVERSE (CDR |LETTMP#1|))) - (SPADLET |itlist| (|outputTranIteration| |itl|)) - (CONS (QUOTE BRACKET) - (CONS - (CONS (QUOTE CONCATB) (CONS (|outputTran| |body|) (CONS |itlist| NIL))) - NIL)))))) +(DEFUN |outputTranCollect| (G167025) + (PROG (|LETTMP#1| |body| |itl| |itlist|) + (RETURN + (PROGN + (SPADLET |LETTMP#1| (REVERSE (CDR G167025))) + (SPADLET |body| (CAR |LETTMP#1|)) + (SPADLET |itl| (NREVERSE (CDR |LETTMP#1|))) + (SPADLET |itlist| (|outputTranIteration| |itl|)) + (CONS 'BRACKET + (CONS (CONS 'CONCATB + (CONS (|outputTran| |body|) + (CONS |itlist| NIL))) + NIL)))))) ;outputTranIteration itl == ; null rest itl => outputTranIterate first itl ; ['CONCATB,outputTranIterate first itl,outputTranIteration rest itl] (DEFUN |outputTranIteration| (|itl|) - (COND - ((NULL (CDR |itl|)) (|outputTranIterate| (CAR |itl|))) - ((QUOTE T) - (CONS (QUOTE CONCATB) - (CONS - (|outputTranIterate| (CAR |itl|)) - (CONS (|outputTranIteration| (CDR |itl|)) NIL)))))) + (COND + ((NULL (CDR |itl|)) (|outputTranIterate| (CAR |itl|))) + ('T + (CONS 'CONCATB + (CONS (|outputTranIterate| (CAR |itl|)) + (CONS (|outputTranIteration| (CDR |itl|)) NIL)))))) ;outputTranIterate x == ; x is ['STEP,n,init,step,:final] => @@ -1389,75 +1407,70 @@ NIL ; throwKeyedMsg("S2IX0008",['outputTranIterate,['"illegal iterate: ",x]]) (DEFUN |outputTranIterate| (|x|) - (PROG (|init| |ISTMP#3| |step| |final| |init'| |final'| |n| |ISTMP#2| - |s| |ISTMP#1| |p| |op|) - (RETURN - (COND - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE STEP)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |n| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |init| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#3|) - (PROGN - (SPADLET |step| (QCAR |ISTMP#3|)) - (SPADLET |final| (QCDR |ISTMP#3|)) - (QUOTE T))))))))) - (SPADLET |init'| (|outputTran| |init|)) - (COND - ((LISTP |init|) - (SPADLET |init'| (CONS (QUOTE PAREN) (CONS |init'| NIL))))) - (SPADLET |final'| + (PROG (|init| |ISTMP#3| |step| |final| |init'| |final'| |n| |ISTMP#2| + |s| |ISTMP#1| |p| |op|) + (RETURN (COND - (|final| - (COND - ((LISTP (CAR |final|)) - (CONS - (CONS (QUOTE PAREN) (CONS (|outputTran| (CAR |final|)) NIL)) - NIL)) - ((QUOTE T) (CONS (|outputTran| (CAR |final|)) NIL)))) - ((QUOTE T) NIL))) - (CONS (QUOTE STEP) - (CONS (|outputTran| |n|) - (CONS |init'| (CONS (|outputTran| |step|) |final'|))))) - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE IN)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |n| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |s| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (CONS (QUOTE IN) (CONS (|outputTran| |n|) (CONS (|outputTran| |s|) NIL)))) - ((AND (PAIRP |x|) - (PROGN - (SPADLET |op| (QCAR |x|)) - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) (QUOTE T)))) - (|member| |op| (QUOTE (|\|| UNTIL WHILE)))) - (SPADLET |op| (DOWNCASE |op|)) - (CONS (QUOTE CONCATB) (CONS |op| (CONS (|outputTran| |p|) NIL)))) - ((QUOTE T) - (|throwKeyedMsg| (QUOTE S2IX0008) - (CONS (QUOTE |outputTranIterate|) - (CONS (CONS "illegal iterate: " (CONS |x| NIL)) NIL)))))))) + ((AND (PAIRP |x|) (EQ (QCAR |x|) 'STEP) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |n| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |init| (QCAR |ISTMP#2|)) + (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (PROGN + (SPADLET |step| (QCAR |ISTMP#3|)) + (SPADLET |final| (QCDR |ISTMP#3|)) + 'T)))))))) + (SPADLET |init'| (|outputTran| |init|)) + (COND + ((LISTP |init|) + (SPADLET |init'| (CONS 'PAREN (CONS |init'| NIL))))) + (SPADLET |final'| + (COND + (|final| (COND + ((LISTP (CAR |final|)) + (CONS (CONS 'PAREN + (CONS + (|outputTran| (CAR |final|)) + NIL)) + NIL)) + ('T + (CONS (|outputTran| (CAR |final|)) NIL)))) + ('T NIL))) + (CONS 'STEP + (CONS (|outputTran| |n|) + (CONS |init'| + (CONS (|outputTran| |step|) |final'|))))) + ((AND (PAIRP |x|) (EQ (QCAR |x|) 'IN) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |n| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (PROGN (SPADLET |s| (QCAR |ISTMP#2|)) 'T)))))) + (CONS 'IN + (CONS (|outputTran| |n|) (CONS (|outputTran| |s|) NIL)))) + ((AND (PAIRP |x|) + (PROGN + (SPADLET |op| (QCAR |x|)) + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) 'T))) + (|member| |op| '(|\|| UNTIL WHILE))) + (SPADLET |op| (DOWNCASE |op|)) + (CONS 'CONCATB (CONS |op| (CONS (|outputTran| |p|) NIL)))) + ('T + (|throwKeyedMsg| 'S2IX0008 + (CONS '|outputTranIterate| + (CONS (CONS "illegal iterate: " (CONS |x| NIL)) NIL)))))))) ;outputConstructTran x == ; x is [op,a,b] => @@ -1477,68 +1490,64 @@ NIL ; [outputTran first x,:outputConstructTran rest x] (DEFUN |outputConstructTran| (|x|) - (PROG (|op| |ISTMP#2| |a| |b| |ISTMP#1| |c| |aPart| |l|) - (RETURN - (COND - ((AND (PAIRP |x|) - (PROGN - (SPADLET |op| (QCAR |x|)) - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |a| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (SPADLET |a| (|outputTran| |a|)) - (SPADLET |b| (|outputTran| |b|)) - (COND - ((BOOT-EQUAL |op| (QUOTE |cons|)) - (COND - ((AND (PAIRP |b|) - (EQ (QCAR |b|) (QUOTE |construct|)) - (PROGN (SPADLET |l| (QCDR |b|)) (QUOTE T))) - (CONS (QUOTE |construct|) (CONS |a| |l|))) - ((QUOTE T) - (CONS (QUOTE BRACKET) - (CONS - (CONS (QUOTE AGGLST) - (CONS |a| (CONS (CONS (QUOTE |:|) (CONS |b| NIL)) NIL))) - NIL))))) - ((BOOT-EQUAL |op| (QUOTE |nconc|)) - (SPADLET |aPart| - (COND - ((AND (PAIRP |a|) - (EQ (QCAR |a|) (QUOTE |construct|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |a|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |c| (QCAR |ISTMP#1|)) (QUOTE T)))) - (PAIRP |c|) - (EQ (QCAR |c|) (QUOTE SEGMENT))) - |c|) - ((QUOTE T) - (CONS (QUOTE |:|) (CONS |a| NIL))))) - (COND - ((AND (PAIRP |b|) - (EQ (QCAR |b|) (QUOTE |construct|)) - (PROGN (SPADLET |l| (QCDR |b|)) (QUOTE T))) - (CONS (QUOTE |construct|) (CONS |aPart| |l|))) - ((QUOTE T) - (CONS (QUOTE BRACKET) - (CONS - (CONS (QUOTE AGGLST) - (CONS |aPart| (CONS (CONS (QUOTE |:|) (CONS |b| NIL)) NIL))) - NIL))))) - ((QUOTE T) (CONS |op| (CONS |a| (CONS |b| NIL)))))) - ((ATOM |x|) |x|) - ((QUOTE T) - (CONS (|outputTran| (CAR |x|)) (|outputConstructTran| (CDR |x|)))))))) + (PROG (|op| |ISTMP#2| |a| |b| |ISTMP#1| |c| |aPart| |l|) + (RETURN + (COND + ((AND (PAIRP |x|) + (PROGN + (SPADLET |op| (QCAR |x|)) + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |a| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) 'T)))))) + (SPADLET |a| (|outputTran| |a|)) + (SPADLET |b| (|outputTran| |b|)) + (COND + ((BOOT-EQUAL |op| '|cons|) + (COND + ((AND (PAIRP |b|) (EQ (QCAR |b|) '|construct|) + (PROGN (SPADLET |l| (QCDR |b|)) 'T)) + (CONS '|construct| (CONS |a| |l|))) + ('T + (CONS 'BRACKET + (CONS (CONS 'AGGLST + (CONS |a| + (CONS (CONS '|:| (CONS |b| NIL)) + NIL))) + NIL))))) + ((BOOT-EQUAL |op| '|nconc|) + (SPADLET |aPart| + (COND + ((AND (PAIRP |a|) (EQ (QCAR |a|) '|construct|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |a|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |c| (QCAR |ISTMP#1|)) + 'T))) + (PAIRP |c|) (EQ (QCAR |c|) 'SEGMENT)) + |c|) + ('T (CONS '|:| (CONS |a| NIL))))) + (COND + ((AND (PAIRP |b|) (EQ (QCAR |b|) '|construct|) + (PROGN (SPADLET |l| (QCDR |b|)) 'T)) + (CONS '|construct| (CONS |aPart| |l|))) + ('T + (CONS 'BRACKET + (CONS (CONS 'AGGLST + (CONS |aPart| + (CONS (CONS '|:| (CONS |b| NIL)) + NIL))) + NIL))))) + ('T (CONS |op| (CONS |a| (CONS |b| NIL)))))) + ((ATOM |x|) |x|) + ('T + (CONS (|outputTran| (CAR |x|)) + (|outputConstructTran| (CDR |x|)))))))) ;outputTranMatrix x == ; not VECP x => @@ -1554,46 +1563,48 @@ NIL ; ["ROW",:[outputTran x.i for i in 0..MAXINDEX x]] (DEFUN |outputTranMatrix,outtranRow| (|x|) - (PROG NIL - (RETURN - (SEQ - (IF (NULL (VECP |x|)) - (EXIT - (|keyedSystemError| (QUOTE S2GE0016) - (CONS "outputTranMatrix" - (CONS "improper internal form for matrix found in output routines" - NIL))))) - (EXIT - (CONS (QUOTE ROW) - (PROG (#0=G167193) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=G167198 (MAXINDEX |x|)) (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| #1#) (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# (CONS (|outputTran| (ELT |x| |i|)) #0#))))))))))))) + (PROG () + (RETURN + (SEQ (IF (NULL (VECP |x|)) + (EXIT (|keyedSystemError| 'S2GE0016 + (CONS "outputTranMatrix" + (CONS "improper internal form for matrix found in output routines" + NIL))))) + (EXIT (CONS 'ROW + (PROG (G167193) + (SPADLET G167193 NIL) + (RETURN + (DO ((G167198 (MAXINDEX |x|)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G167198) + (NREVERSE0 G167193)) + (SEQ (EXIT (SETQ G167193 + (CONS + (|outputTran| (ELT |x| |i|)) + G167193))))))))))))) + (DEFUN |outputTranMatrix| (|x|) - (PROG NIL - (RETURN - (SEQ - (COND - ((NULL (VECP |x|)) (CONS (QUOTE MATRIX) |x|)) - ((QUOTE T) - (CONS (QUOTE MATRIX) - (CONS NIL - (PROG (#0=G167212) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=G167217 (MAXINDEX |x|)) (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| #1#) (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS - (|outputTranMatrix,outtranRow| (ELT |x| |i|)) - #0#))))))))))))))) + (PROG () + (RETURN + (SEQ (COND + ((NULL (VECP |x|)) (CONS 'MATRIX |x|)) + ('T + (CONS 'MATRIX + (CONS NIL + (PROG (G167212) + (SPADLET G167212 NIL) + (RETURN + (DO ((G167217 (MAXINDEX |x|)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G167217) + (NREVERSE0 G167212)) + (SEQ (EXIT + (SETQ G167212 + (CONS + (|outputTranMatrix,outtranRow| + (ELT |x| |i|)) + G167212))))))))))))))) ;mkSuperSub(op,argl) == ; $linearFormatScripts => linearFormatForm(op,argl) @@ -1624,58 +1635,78 @@ NIL ; superSub (DEFUN |mkSuperSub| (|op| |argl|) - (PROG (|s| |maxIndex| |d| |indexList| |cleanOp| |subPart| |l| |this| - |scripts| |superSubPart| |superSub|) - (RETURN - (SEQ - (COND - (|$linearFormatScripts| (|linearFormatForm| |op| |argl|)) - ((QUOTE T) - (SPADLET |s| (PNAME |op|)) - (SPADLET |indexList| - (PROG (#0=G167234) - (SPADLET #0# NIL) - (RETURN - (DO ((|i| 1 (QSADD1 |i|))) - ((NULL (DIGITP (SPADLET |d| (ELT |s| (SPADLET |maxIndex| |i|))))) - (NREVERSE0 #0#)) - (SEQ (EXIT (SETQ #0# (CONS (PARSE-INTEGER (PNAME |d|)) #0#)))))))) - (SPADLET |cleanOp| - (INTERN - (PROG (#1=G167243) - (SPADLET #1# "") - (RETURN - (DO ((#2=G167248 (MAXINDEX |s|)) (|i| |maxIndex| (+ |i| 1))) - ((> |i| #2#) #1#) - (SEQ (EXIT (SETQ #1# (STRCONC #1# (PNAME (ELT |s| |i|))))))))))) - (COND - ((EQL (|#| |indexList|) 2) - (SPADLET |subPart| - (CONS (QUOTE SUB) (CONS |cleanOp| (TAKE (ELT |indexList| 1) |argl|)))) - (COND - ((SPADLET |l| (DROP (ELT |indexList| 1) |argl|)) (CONS |subPart| |l|)) - ((QUOTE T) |subPart|))) - ((QUOTE T) - (SPADLET |superSubPart| NIL) - (DO ((#3=G167260 (CDR |indexList|) (CDR #3#)) (|i| NIL)) - ((OR (ATOM #3#) (PROGN (SETQ |i| (CAR #3#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |scripts| - (PROGN - (SPADLET |this| (TAKE |i| |argl|)) - (SPADLET |argl| (DROP |i| |argl|)) + (PROG (|s| |maxIndex| |d| |indexList| |cleanOp| |subPart| |l| |this| + |scripts| |superSubPart| |superSub|) + (DECLARE (SPECIAL |$linearFormatScripts|)) + (RETURN + (SEQ (COND + (|$linearFormatScripts| (|linearFormatForm| |op| |argl|)) + ('T (SPADLET |s| (PNAME |op|)) + (SPADLET |indexList| + (PROG (G167234) + (SPADLET G167234 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((NULL (DIGITP + (SPADLET |d| + (ELT |s| + (SPADLET |maxIndex| |i|))))) + (NREVERSE0 G167234)) + (SEQ (EXIT (SETQ G167234 + (CONS + (PARSE-INTEGER (PNAME |d|)) + G167234)))))))) + (SPADLET |cleanOp| + (INTERN (PROG (G167243) + (SPADLET G167243 "") + (RETURN + (DO + ((G167248 (MAXINDEX |s|)) + (|i| |maxIndex| (+ |i| 1))) + ((> |i| G167248) G167243) + (SEQ + (EXIT + (SETQ G167243 + (STRCONC G167243 + (PNAME (ELT |s| |i|))))))))))) (COND - ((EQL |i| 0) (CONS (QUOTE AGGLST) NIL)) - ((EQL |i| 1) (CAR |this|)) - ((QUOTE T) (CONS (QUOTE AGGLST) |this|))))) - (SPADLET |superSubPart| (CONS |scripts| |superSubPart|)))))) - (SPADLET |superSub| - (CONS (QUOTE SUPERSUB) (CONS |cleanOp| (REVERSE |superSubPart|)))) - (COND - (|argl| (CONS |superSub| |argl|)) - ((QUOTE T) |superSub|)))))))))) + ((EQL (|#| |indexList|) 2) + (SPADLET |subPart| + (CONS 'SUB + (CONS |cleanOp| + (TAKE (ELT |indexList| 1) |argl|)))) + (COND + ((SPADLET |l| (DROP (ELT |indexList| 1) |argl|)) + (CONS |subPart| |l|)) + ('T |subPart|))) + ('T (SPADLET |superSubPart| NIL) + (DO ((G167260 (CDR |indexList|) (CDR G167260)) + (|i| NIL)) + ((OR (ATOM G167260) + (PROGN (SETQ |i| (CAR G167260)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |scripts| + (PROGN + (SPADLET |this| + (TAKE |i| |argl|)) + (SPADLET |argl| + (DROP |i| |argl|)) + (COND + ((EQL |i| 0) + (CONS 'AGGLST NIL)) + ((EQL |i| 1) (CAR |this|)) + ('T (CONS 'AGGLST |this|))))) + (SPADLET |superSubPart| + (CONS |scripts| + |superSubPart|)))))) + (SPADLET |superSub| + (CONS 'SUPERSUB + (CONS |cleanOp| + (REVERSE |superSubPart|)))) + (COND + (|argl| (CONS |superSub| |argl|)) + ('T |superSub|)))))))))) ;timesApp(u,x,y,d) == ; rightPrec:= getOpBindingPower("*","Led","right") @@ -1696,43 +1727,47 @@ NIL ; d (DEFUN |timesApp| (|u| |x| |y| |d|) - (PROG (|rightPrec| |op| |LETTMP#1| |wasSimple| |wasQuotient| |wasNumber| - |lastOp| |firstTime|) - (RETURN - (SEQ - (PROGN - (SPADLET |rightPrec| - (|getOpBindingPower| (QUOTE *) (QUOTE |Led|) (QUOTE |right|))) - (SPADLET |firstTime| (QUOTE T)) - (DO ((#0=G167307 (CDR |u|) (CDR #0#)) (|arg| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |arg| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |op| (|keyp| |arg|)) - (COND - ((AND - (NULL |firstTime|) - (OR - (|needBlankForRoot| |lastOp| |op| |arg|) - (|needStar| |wasSimple| |wasQuotient| |wasNumber| |arg| |op|) - (AND - |wasNumber| - (BOOT-EQUAL |op| (QUOTE ROOT)) - (EQL (|subspan| |arg|) 1)))) - (SPADLET |d| (APP BLANK |x| |y| |d|)) (SPADLET |x| (PLUS |x| 1)))) - (SPADLET |LETTMP#1| - (|appInfixArg| |arg| |x| |y| |d| |rightPrec| (QUOTE |left|) NIL)) - (SPADLET |d| (CAR |LETTMP#1|)) - (SPADLET |x| (CADR |LETTMP#1|)) - (SPADLET |wasSimple| - (OR - (AND (ATOM |arg|) (NULL (NUMBERP |arg|))) - (|isRationalNumber| |arg|))) - (SPADLET |wasQuotient| (|isQuotient| |op|)) - (SPADLET |wasNumber| (NUMBERP |arg|)) - (SPADLET |lastOp| |op|) (SPADLET |firstTime| NIL))))) - |d|))))) + (PROG (|rightPrec| |op| |LETTMP#1| |wasSimple| |wasQuotient| + |wasNumber| |lastOp| |firstTime|) + (RETURN + (SEQ (PROGN + (SPADLET |rightPrec| + (|getOpBindingPower| '* '|Led| '|right|)) + (SPADLET |firstTime| 'T) + (DO ((G167307 (CDR |u|) (CDR G167307)) (|arg| NIL)) + ((OR (ATOM G167307) + (PROGN (SETQ |arg| (CAR G167307)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |op| (|keyp| |arg|)) + (COND + ((AND (NULL |firstTime|) + (OR + (|needBlankForRoot| |lastOp| |op| + |arg|) + (|needStar| |wasSimple| + |wasQuotient| |wasNumber| |arg| + |op|) + (AND |wasNumber| + (BOOT-EQUAL |op| 'ROOT) + (EQL (|subspan| |arg|) 1)))) + (SPADLET |d| (APP BLANK |x| |y| |d|)) + (SPADLET |x| (PLUS |x| 1)))) + (SPADLET |LETTMP#1| + (|appInfixArg| |arg| |x| |y| |d| + |rightPrec| '|left| NIL)) + (SPADLET |d| (CAR |LETTMP#1|)) + (SPADLET |x| (CADR |LETTMP#1|)) + (SPADLET |wasSimple| + (OR + (AND (ATOM |arg|) + (NULL (NUMBERP |arg|))) + (|isRationalNumber| |arg|))) + (SPADLET |wasQuotient| (|isQuotient| |op|)) + (SPADLET |wasNumber| (NUMBERP |arg|)) + (SPADLET |lastOp| |op|) + (SPADLET |firstTime| NIL))))) + |d|))))) ;needBlankForRoot(lastOp,op,arg) == ; lastOp ^= "^" and lastOp ^= "**" and not(subspan(arg)>0) => false @@ -1742,21 +1777,18 @@ NIL ; false (DEFUN |needBlankForRoot| (|lastOp| |op| |arg|) - (COND - ((AND (NEQUAL |lastOp| (QUOTE ^)) - (NEQUAL |lastOp| (QUOTE **)) - (NULL (> (|subspan| |arg|) 0))) - NIL) - ((AND (BOOT-EQUAL |op| (QUOTE **)) - (BOOT-EQUAL (|keyp| (CADR |arg|)) (QUOTE ROOT))) - (QUOTE T)) - ((AND (BOOT-EQUAL |op| (QUOTE ^)) - (BOOT-EQUAL (|keyp| (CADR |arg|)) (QUOTE ROOT))) - (QUOTE T)) - ((AND (BOOT-EQUAL |op| (QUOTE ROOT)) (CDDR |arg|)) - (QUOTE T)) - ((QUOTE T) - NIL))) + (COND + ((AND (NEQUAL |lastOp| '^) (NEQUAL |lastOp| '**) + (NULL (> (|subspan| |arg|) 0))) + NIL) + ((AND (BOOT-EQUAL |op| '**) + (BOOT-EQUAL (|keyp| (CADR |arg|)) 'ROOT)) + 'T) + ((AND (BOOT-EQUAL |op| '^) + (BOOT-EQUAL (|keyp| (CADR |arg|)) 'ROOT)) + 'T) + ((AND (BOOT-EQUAL |op| 'ROOT) (CDDR |arg|)) 'T) + ('T NIL))) ;stepApp([.,a,init,one,:optFinal],x,y,d) == ; d:= appChar('"for ",x,y,d) @@ -1767,76 +1799,77 @@ NIL ; if optFinal then d:= APP(first optFinal,w+2,y,d) ; d -(DEFUN |stepApp| (#0=G167334 |x| |y| |d|) - (PROG (|a| |init| |one| |optFinal| |w|) - (RETURN - (PROGN - (SPADLET |a| (CADR #0#)) - (SPADLET |init| (CADDR #0#)) - (SPADLET |one| (CADDDR #0#)) - (SPADLET |optFinal| (CDDDDR #0#)) - (SPADLET |d| (|appChar| (MAKESTRING "for ") |x| |y| |d|)) - (SPADLET |d| (APP |a| (SPADLET |w| (PLUS |x| 4)) |y| |d|)) - (SPADLET |d| - (|appChar| " in " (SPADLET |w| (PLUS |w| (WIDTH |a|))) |y| |d|)) - (SPADLET |d| (APP |init| (SPADLET |w| (PLUS |w| 4)) |y| |d|)) - (SPADLET |d| (APP ".." (SPADLET |w| (PLUS |w| (WIDTH |init|))) |y| |d|)) - (COND - (|optFinal| (SPADLET |d| (APP (CAR |optFinal|) (PLUS |w| 2) |y| |d|)))) - |d|)))) +(DEFUN |stepApp| (G167334 |x| |y| |d|) + (PROG (|a| |init| |one| |optFinal| |w|) + (RETURN + (PROGN + (SPADLET |a| (CADR G167334)) + (SPADLET |init| (CADDR G167334)) + (SPADLET |one| (CADDDR G167334)) + (SPADLET |optFinal| (CDDDDR G167334)) + (SPADLET |d| (|appChar| (MAKESTRING "for ") |x| |y| |d|)) + (SPADLET |d| (APP |a| (SPADLET |w| (PLUS |x| 4)) |y| |d|)) + (SPADLET |d| + (|appChar| " in " (SPADLET |w| (PLUS |w| (WIDTH |a|))) + |y| |d|)) + (SPADLET |d| (APP |init| (SPADLET |w| (PLUS |w| 4)) |y| |d|)) + (SPADLET |d| + (APP ".." (SPADLET |w| (PLUS |w| (WIDTH |init|))) |y| + |d|)) + (COND + (|optFinal| + (SPADLET |d| (APP (CAR |optFinal|) (PLUS |w| 2) |y| |d|)))) + |d|)))) ;stepSub [.,a,init,one,:optFinal] == ; m:= MAX(subspan a,subspan init) ; optFinal => MAX(m,subspan first optFinal) ; m -(DEFUN |stepSub| (#0=G167365) - (PROG (|a| |init| |one| |optFinal| |m|) - (RETURN - (PROGN - (SPADLET |a| (CADR #0#)) - (SPADLET |init| (CADDR #0#)) - (SPADLET |one| (CADDDR #0#)) - (SPADLET |optFinal| (CDDDDR #0#)) - (SPADLET |m| (MAX (|subspan| |a|) (|subspan| |init|))) - (COND - (|optFinal| (MAX |m| (|subspan| (CAR |optFinal|)))) - ((QUOTE T) |m|)))))) +(DEFUN |stepSub| (G167365) + (PROG (|a| |init| |one| |optFinal| |m|) + (RETURN + (PROGN + (SPADLET |a| (CADR G167365)) + (SPADLET |init| (CADDR G167365)) + (SPADLET |one| (CADDDR G167365)) + (SPADLET |optFinal| (CDDDDR G167365)) + (SPADLET |m| (MAX (|subspan| |a|) (|subspan| |init|))) + (COND + (|optFinal| (MAX |m| (|subspan| (CAR |optFinal|)))) + ('T |m|)))))) ;stepSuper [.,a,init,one,:optFinal] == ; m:= MAX(superspan a,superspan init) ; optFinal => MAX(m,superspan first optFinal) ; m -(DEFUN |stepSuper| (#0=G167387) - (PROG (|a| |init| |one| |optFinal| |m|) - (RETURN - (PROGN - (SPADLET |a| (CADR #0#)) - (SPADLET |init| (CADDR #0#)) - (SPADLET |one| (CADDDR #0#)) - (SPADLET |optFinal| (CDDDDR #0#)) - (SPADLET |m| (MAX (|superspan| |a|) (|superspan| |init|))) - (COND - (|optFinal| (MAX |m| (|superspan| (CAR |optFinal|)))) - ((QUOTE T) |m|)))))) +(DEFUN |stepSuper| (G167387) + (PROG (|a| |init| |one| |optFinal| |m|) + (RETURN + (PROGN + (SPADLET |a| (CADR G167387)) + (SPADLET |init| (CADDR G167387)) + (SPADLET |one| (CADDDR G167387)) + (SPADLET |optFinal| (CDDDDR G167387)) + (SPADLET |m| (MAX (|superspan| |a|) (|superspan| |init|))) + (COND + (|optFinal| (MAX |m| (|superspan| (CAR |optFinal|)))) + ('T |m|)))))) ;stepWidth [.,a,init,one,:optFinal] == ; 10+WIDTH a+WIDTH init+(optFinal => WIDTH first optFinal; 0) -(DEFUN |stepWidth| (#0=G167409) - (PROG (|a| |init| |one| |optFinal|) - (RETURN - (PROGN - (SPADLET |a| (CADR #0#)) - (SPADLET |init| (CADDR #0#)) - (SPADLET |one| (CADDDR #0#)) - (SPADLET |optFinal| (CDDDDR #0#)) - (PLUS - (PLUS (PLUS 10 (WIDTH |a|)) (WIDTH |init|)) - (COND - (|optFinal| (WIDTH (CAR |optFinal|))) - ((QUOTE T) 0))))))) +(DEFUN |stepWidth| (G167409) + (PROG (|a| |init| |one| |optFinal|) + (RETURN + (PROGN + (SPADLET |a| (CADR G167409)) + (SPADLET |init| (CADDR G167409)) + (SPADLET |one| (CADDDR G167409)) + (SPADLET |optFinal| (CDDDDR G167409)) + (PLUS (PLUS (PLUS 10 (WIDTH |a|)) (WIDTH |init|)) + (COND (|optFinal| (WIDTH (CAR |optFinal|))) ('T 0))))))) ;inApp([.,a,s],x,y,d) == --for [IN,a,s] ; d:= appChar('"for ",x,y,d) @@ -1844,74 +1877,76 @@ NIL ; d:= appChar('" in ",x+WIDTH a+4,y,d) ; APP(s,x+WIDTH a+8,y,d) -(DEFUN |inApp| (#0=G167430 |x| |y| |d|) - (PROG (|a| |s|) - (RETURN - (PROGN - (SPADLET |a| (CADR #0#)) - (SPADLET |s| (CADDR #0#)) - (SPADLET |d| (|appChar| "for " |x| |y| |d|)) - (SPADLET |d| (APP |a| (PLUS |x| 4) |y| |d|)) - (SPADLET |d| (|appChar| " in " (PLUS (PLUS |x| (WIDTH |a|)) 4) |y| |d|)) - (APP |s| (PLUS (PLUS |x| (WIDTH |a|)) 8) |y| |d|))))) +(DEFUN |inApp| (G167430 |x| |y| |d|) + (PROG (|a| |s|) + (RETURN + (PROGN + (SPADLET |a| (CADR G167430)) + (SPADLET |s| (CADDR G167430)) + (SPADLET |d| (|appChar| "for " |x| |y| |d|)) + (SPADLET |d| (APP |a| (PLUS |x| 4) |y| |d|)) + (SPADLET |d| + (|appChar| " in " (PLUS (PLUS |x| (WIDTH |a|)) 4) |y| + |d|)) + (APP |s| (PLUS (PLUS |x| (WIDTH |a|)) 8) |y| |d|))))) ;inSub [.,a,s] == MAX(subspan a,subspan s) -(DEFUN |inSub| (#0=G167447) - (PROG (|a| |s|) - (RETURN - (PROGN - (SPADLET |a| (CADR #0#)) - (SPADLET |s| (CADDR #0#)) - (MAX (|subspan| |a|) (|subspan| |s|)))))) +(DEFUN |inSub| (G167447) + (PROG (|a| |s|) + (RETURN + (PROGN + (SPADLET |a| (CADR G167447)) + (SPADLET |s| (CADDR G167447)) + (MAX (|subspan| |a|) (|subspan| |s|)))))) ;inSuper [.,a,s] == MAX(superspan a,superspan s) -(DEFUN |inSuper| (#0=G167461) - (PROG (|a| |s|) - (RETURN - (PROGN - (SPADLET |a| (CADR #0#)) - (SPADLET |s| (CADDR #0#)) - (MAX (|superspan| |a|) (|superspan| |s|)))))) +(DEFUN |inSuper| (G167461) + (PROG (|a| |s|) + (RETURN + (PROGN + (SPADLET |a| (CADR G167461)) + (SPADLET |s| (CADDR G167461)) + (MAX (|superspan| |a|) (|superspan| |s|)))))) ;inWidth [.,a,s] == 8+WIDTH a+WIDTH s -(DEFUN |inWidth| (#0=G167475) - (PROG (|a| |s|) - (RETURN - (PROGN - (SPADLET |a| (CADR #0#)) - (SPADLET |s| (CADDR #0#)) - (PLUS (PLUS 8 (WIDTH |a|)) (WIDTH |s|)))))) +(DEFUN |inWidth| (G167475) + (PROG (|a| |s|) + (RETURN + (PROGN + (SPADLET |a| (CADR G167475)) + (SPADLET |s| (CADDR G167475)) + (PLUS (PLUS 8 (WIDTH |a|)) (WIDTH |s|)))))) ;centerApp([.,u],x,y,d) == ; d := APP(u,x,y,d) -(DEFUN |centerApp| (#0=G167489 |x| |y| |d|) - (PROG (|u|) - (RETURN - (PROGN - (SPADLET |u| (CADR #0#)) - (SPADLET |d| (APP |u| |x| |y| |d|)))))) +(DEFUN |centerApp| (G167489 |x| |y| |d|) + (PROG (|u|) + (RETURN + (PROGN + (SPADLET |u| (CADR G167489)) + (SPADLET |d| (APP |u| |x| |y| |d|)))))) ;concatApp([.,:l],x,y,d) == concatApp1(l,x,y,d,0) -(DEFUN |concatApp| (#0=G167501 |x| |y| |d|) - (PROG (|l|) - (RETURN - (PROGN - (SPADLET |l| (CDR #0#)) - (|concatApp1| |l| |x| |y| |d| 0))))) +(DEFUN |concatApp| (G167501 |x| |y| |d|) + (PROG (|l|) + (RETURN + (PROGN + (SPADLET |l| (CDR G167501)) + (|concatApp1| |l| |x| |y| |d| 0))))) ;concatbApp([.,:l],x,y,d) == concatApp1(l,x,y,d,1) -(DEFUN |concatbApp| (#0=G167512 |x| |y| |d|) - (PROG (|l|) - (RETURN - (PROGN - (SPADLET |l| (CDR #0#)) - (|concatApp1| |l| |x| |y| |d| 1))))) +(DEFUN |concatbApp| (G167512 |x| |y| |d|) + (PROG (|l|) + (RETURN + (PROGN + (SPADLET |l| (CDR G167512)) + (|concatApp1| |l| |x| |y| |d| 1))))) ;concatApp1(l,x,y,d,n) == ; for u in l repeat @@ -1920,77 +1955,84 @@ NIL ; d (DEFUN |concatApp1| (|l| |x| |y| |d| |n|) - (SEQ - (PROGN - (DO ((#0=G167530 |l| (CDR #0#)) (|u| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |u| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |d| (APP |u| |x| |y| |d|)) - (SPADLET |x| (PLUS (PLUS |x| (WIDTH |u|)) |n|)))))) - |d|))) + (SEQ (PROGN + (DO ((G167530 |l| (CDR G167530)) (|u| NIL)) + ((OR (ATOM G167530) (PROGN (SETQ |u| (CAR G167530)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |d| (APP |u| |x| |y| |d|)) + (SPADLET |x| (PLUS (PLUS |x| (WIDTH |u|)) |n|)))))) + |d|))) ;concatSub [.,:l] == "MAX"/[subspan x for x in l] -(DEFUN |concatSub| (#0=G167541) - (PROG (|l|) - (RETURN - (SEQ - (PROGN - (SPADLET |l| (CDR #0#)) - (PROG (#1=G167548) - (SPADLET #1# -999999) - (RETURN - (DO ((#2=G167553 |l| (CDR #2#)) (|x| NIL)) - ((OR (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #1#) - (SEQ (EXIT (SETQ #1# (MAX #1# (|subspan| |x|))))))))))))) +(DEFUN |concatSub| (G167541) + (PROG (|l|) + (RETURN + (SEQ (PROGN + (SPADLET |l| (CDR G167541)) + (PROG (G167548) + (SPADLET G167548 -999999) + (RETURN + (DO ((G167553 |l| (CDR G167553)) (|x| NIL)) + ((OR (ATOM G167553) + (PROGN (SETQ |x| (CAR G167553)) NIL)) + G167548) + (SEQ (EXIT (SETQ G167548 + (MAX G167548 (|subspan| |x|))))))))))))) ;concatSuper [.,:l] == "MAX"/[superspan x for x in l] -(DEFUN |concatSuper| (#0=G167564) - (PROG (|l|) - (RETURN - (SEQ - (PROGN - (SPADLET |l| (CDR #0#)) - (PROG (#1=G167571) - (SPADLET #1# -999999) - (RETURN - (DO ((#2=G167576 |l| (CDR #2#)) (|x| NIL)) - ((OR (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #1#) - (SEQ (EXIT (SETQ #1# (MAX #1# (|superspan| |x|))))))))))))) +(DEFUN |concatSuper| (G167564) + (PROG (|l|) + (RETURN + (SEQ (PROGN + (SPADLET |l| (CDR G167564)) + (PROG (G167571) + (SPADLET G167571 -999999) + (RETURN + (DO ((G167576 |l| (CDR G167576)) (|x| NIL)) + ((OR (ATOM G167576) + (PROGN (SETQ |x| (CAR G167576)) NIL)) + G167571) + (SEQ (EXIT (SETQ G167571 + (MAX G167571 (|superspan| |x|))))))))))))) ;concatWidth [.,:l] == +/[WIDTH x for x in l] -(DEFUN |concatWidth| (#0=G167587) - (PROG (|l|) - (RETURN - (SEQ - (PROGN - (SPADLET |l| (CDR #0#)) - (PROG (#1=G167594) - (SPADLET #1# 0) - (RETURN - (DO ((#2=G167599 |l| (CDR #2#)) (|x| NIL)) - ((OR (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #1#) - (SEQ (EXIT (SETQ #1# (PLUS #1# (WIDTH |x|))))))))))))) +(DEFUN |concatWidth| (G167587) + (PROG (|l|) + (RETURN + (SEQ (PROGN + (SPADLET |l| (CDR G167587)) + (PROG (G167594) + (SPADLET G167594 0) + (RETURN + (DO ((G167599 |l| (CDR G167599)) (|x| NIL)) + ((OR (ATOM G167599) + (PROGN (SETQ |x| (CAR G167599)) NIL)) + G167594) + (SEQ (EXIT (SETQ G167594 (PLUS G167594 (WIDTH |x|))))))))))))) ;concatbWidth [.,:l] == +/[1+WIDTH x for x in l]-1 -(DEFUN |concatbWidth| (#0=G167610) - (PROG (|l|) - (RETURN - (SEQ - (PROGN - (SPADLET |l| (CDR #0#)) - (SPADDIFFERENCE - (PROG (#1=G167617) - (SPADLET #1# 0) - (RETURN - (DO ((#2=G167622 |l| (CDR #2#)) (|x| NIL)) - ((OR (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #1#) - (SEQ (EXIT (SETQ #1# (PLUS #1# (PLUS 1 (WIDTH |x|))))))))) 1)))))) +(DEFUN |concatbWidth| (G167610) + (PROG (|l|) + (RETURN + (SEQ (PROGN + (SPADLET |l| (CDR G167610)) + (SPADDIFFERENCE + (PROG (G167617) + (SPADLET G167617 0) + (RETURN + (DO ((G167622 |l| (CDR G167622)) (|x| NIL)) + ((OR (ATOM G167622) + (PROGN (SETQ |x| (CAR G167622)) NIL)) + G167617) + (SEQ (EXIT (SETQ G167617 + (PLUS G167617 + (PLUS 1 (WIDTH |x|))))))))) + 1)))))) ;exptApp([.,a,b],x,y,d) == ; pren:= exptNeedsPren a @@ -2001,24 +2043,26 @@ NIL ; y':= 1+y+superspan a+subspan b + (0=superspan a => 0; -1) ; APP(b,x',y',d) -(DEFUN |exptApp| (#0=G167637 |x| |y| |d|) - (PROG (|a| |b| |pren| |x'| |y'|) - (RETURN - (PROGN - (SPADLET |a| (CADR #0#)) - (SPADLET |b| (CADDR #0#)) - (SPADLET |pren| (|exptNeedsPren| |a|)) - (SPADLET |d| - (COND - (|pren| (|appparu| |a| |x| |y| |d|)) - ((QUOTE T) (APP |a| |x| |y| |d|)))) - (SPADLET |x'| - (PLUS (PLUS |x| (WIDTH |a|)) (COND (|pren| 2) ((QUOTE T) 0)))) - (SPADLET |y'| - (PLUS - (PLUS (PLUS (PLUS 1 |y|) (|superspan| |a|)) (|subspan| |b|)) - (COND ((EQL 0 (|superspan| |a|)) 0) ((QUOTE T) (SPADDIFFERENCE 1))))) - (APP |b| |x'| |y'| |d|))))) +(DEFUN |exptApp| (G167637 |x| |y| |d|) + (PROG (|a| |b| |pren| |x'| |y'|) + (RETURN + (PROGN + (SPADLET |a| (CADR G167637)) + (SPADLET |b| (CADDR G167637)) + (SPADLET |pren| (|exptNeedsPren| |a|)) + (SPADLET |d| + (COND + (|pren| (|appparu| |a| |x| |y| |d|)) + ('T (APP |a| |x| |y| |d|)))) + (SPADLET |x'| + (PLUS (PLUS |x| (WIDTH |a|)) (COND (|pren| 2) ('T 0)))) + (SPADLET |y'| + (PLUS (PLUS (PLUS (PLUS 1 |y|) (|superspan| |a|)) + (|subspan| |b|)) + (COND + ((EQL 0 (|superspan| |a|)) 0) + ('T (SPADDIFFERENCE 1))))) + (APP |b| |x'| |y'| |d|))))) ;exptNeedsPren a == ; atom a and null (INTEGERP a and a < 0) => false @@ -2028,48 +2072,46 @@ NIL ; true (DEFUN |exptNeedsPren| (|a|) - (PROG (|key|) - (RETURN - (COND - ((AND (ATOM |a|) (NULL (AND (INTEGERP |a|) (MINUSP |a|)))) NIL) - ((QUOTE T) - (SPADLET |key| (|keyp| |a|)) - (COND - ((BOOT-EQUAL |key| (QUOTE OVER)) (QUOTE T)) - ((OR (BOOT-EQUAL |key| (QUOTE SUB)) - (AND - (NULL (GETL |key| (QUOTE |Nud|))) - (NULL (GETL |key| (QUOTE |Led|))))) - NIL) - ((QUOTE T) (QUOTE T)))))))) + (PROG (|key|) + (RETURN + (COND + ((AND (ATOM |a|) (NULL (AND (INTEGERP |a|) (MINUSP |a|)))) NIL) + ('T (SPADLET |key| (|keyp| |a|)) + (COND + ((BOOT-EQUAL |key| 'OVER) 'T) + ((OR (BOOT-EQUAL |key| 'SUB) + (AND (NULL (GETL |key| '|Nud|)) + (NULL (GETL |key| '|Led|)))) + NIL) + ('T 'T))))))) ;exptSub u == subspan CADR u -(DEFUN |exptSub| (|u|) (|subspan| (CADR |u|))) +(DEFUN |exptSub| (|u|) (|subspan| (CADR |u|))) ;exptSuper [.,a,b] == superspan a+height b+(superspan a=0 => 0;-1) -(DEFUN |exptSuper| (#0=G167664) - (PROG (|a| |b|) - (RETURN - (PROGN - (SPADLET |a| (CADR #0#)) - (SPADLET |b| (CADDR #0#)) - (PLUS - (PLUS (|superspan| |a|) (|height| |b|)) - (COND ((EQL (|superspan| |a|) 0) 0) ((QUOTE T) (SPADDIFFERENCE 1)))))))) +(DEFUN |exptSuper| (G167664) + (PROG (|a| |b|) + (RETURN + (PROGN + (SPADLET |a| (CADR G167664)) + (SPADLET |b| (CADDR G167664)) + (PLUS (PLUS (|superspan| |a|) (|height| |b|)) + (COND + ((EQL (|superspan| |a|) 0) 0) + ('T (SPADDIFFERENCE 1)))))))) ;exptWidth [.,a,b] == WIDTH a+WIDTH b+(exptNeedsPren a => 2;0) -(DEFUN |exptWidth| (#0=G167679) - (PROG (|a| |b|) - (RETURN - (PROGN - (SPADLET |a| (CADR #0#)) - (SPADLET |b| (CADDR #0#)) - (PLUS - (PLUS (WIDTH |a|) (WIDTH |b|)) - (COND ((|exptNeedsPren| |a|) 2) ((QUOTE T) 0))))))) +(DEFUN |exptWidth| (G167679) + (PROG (|a| |b|) + (RETURN + (PROGN + (SPADLET |a| (CADR G167679)) + (SPADLET |b| (CADDR G167679)) + (PLUS (PLUS (WIDTH |a|) (WIDTH |b|)) + (COND ((|exptNeedsPren| |a|) 2) ('T 0))))))) ;needStar(wasSimple,wasQuotient,wasNumber,cur,op) == ; wasQuotient or isQuotient op => true @@ -2081,30 +2123,24 @@ NIL ; ((op="**" or op ="^") and NUMBERP(CADR cur)) (DEFUN |needStar| (|wasSimple| |wasQuotient| |wasNumber| |cur| |op|) - (COND - ((OR |wasQuotient| (|isQuotient| |op|)) (QUOTE T)) - (|wasSimple| - (OR (ATOM |cur|) - (BOOT-EQUAL (|keyp| |cur|) (QUOTE SUB)) - (|isRationalNumber| |cur|) - (BOOT-EQUAL |op| (QUOTE **)) - (BOOT-EQUAL |op| (QUOTE ^)) - (AND (ATOM |op|) (NULL (NUMBERP |op|)) (NULL (GETL |op| (QUOTE APP)))))) - (|wasNumber| - (OR - (NUMBERP |cur|) - (|isRationalNumber| |cur|) - (AND - (OR (BOOT-EQUAL |op| (QUOTE **)) (BOOT-EQUAL |op| (QUOTE ^))) - (NUMBERP (CADR |cur|))))))) + (COND + ((OR |wasQuotient| (|isQuotient| |op|)) 'T) + (|wasSimple| + (OR (ATOM |cur|) (BOOT-EQUAL (|keyp| |cur|) 'SUB) + (|isRationalNumber| |cur|) (BOOT-EQUAL |op| '**) + (BOOT-EQUAL |op| '^) + (AND (ATOM |op|) (NULL (NUMBERP |op|)) + (NULL (GETL |op| 'APP))))) + (|wasNumber| + (OR (NUMBERP |cur|) (|isRationalNumber| |cur|) + (AND (OR (BOOT-EQUAL |op| '**) (BOOT-EQUAL |op| '^)) + (NUMBERP (CADR |cur|))))))) ;isQuotient op == ; op="/" or op="OVER" (DEFUN |isQuotient| (|op|) - (OR - (BOOT-EQUAL |op| (QUOTE /)) - (BOOT-EQUAL |op| (QUOTE OVER)))) + (OR (BOOT-EQUAL |op| '/) (BOOT-EQUAL |op| 'OVER))) ;timesWidth u == ; rightPrec:= getOpBindingPower("*","Led","right") @@ -2123,47 +2159,50 @@ NIL ; w (DEFUN |timesWidth| (|u|) - (PROG (|rightPrec| |op| |w| |wasSimple| |wasQuotient| |wasNumber| |firstTime|) - (RETURN - (SEQ - (PROGN - (SPADLET |rightPrec| - (|getOpBindingPower| (QUOTE *) (QUOTE |Led|) (QUOTE |right|))) - (SPADLET |firstTime| (QUOTE T)) - (SPADLET |w| 0) - (DO ((#0=G167713 (CDR |u|) (CDR #0#)) (|arg| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |arg| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |op| (|keyp| |arg|)) - (COND - ((AND (NULL |firstTime|) - (|needStar| |wasSimple| |wasQuotient| |wasNumber| |arg| |op|)) - (SPADLET |w| (PLUS |w| 1)))) - (COND - ((|infixArgNeedsParens| |arg| |rightPrec| (QUOTE |left|)) - (SPADLET |w| (PLUS |w| 2)))) - (SPADLET |w| (PLUS |w| (WIDTH |arg|))) - (SPADLET |wasSimple| (AND (ATOM |arg|) (NULL (NUMBERP |arg|)))) - (SPADLET |wasQuotient| (|isQuotient| |op|)) - (SPADLET |wasNumber| (NUMBERP |arg|)) - (SPADLET |firstTime| NIL))))) - |w|))))) + (PROG (|rightPrec| |op| |w| |wasSimple| |wasQuotient| |wasNumber| + |firstTime|) + (RETURN + (SEQ (PROGN + (SPADLET |rightPrec| + (|getOpBindingPower| '* '|Led| '|right|)) + (SPADLET |firstTime| 'T) + (SPADLET |w| 0) + (DO ((G167713 (CDR |u|) (CDR G167713)) (|arg| NIL)) + ((OR (ATOM G167713) + (PROGN (SETQ |arg| (CAR G167713)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |op| (|keyp| |arg|)) + (COND + ((AND (NULL |firstTime|) + (|needStar| |wasSimple| + |wasQuotient| |wasNumber| |arg| + |op|)) + (SPADLET |w| (PLUS |w| 1)))) + (COND + ((|infixArgNeedsParens| |arg| |rightPrec| + '|left|) + (SPADLET |w| (PLUS |w| 2)))) + (SPADLET |w| (PLUS |w| (WIDTH |arg|))) + (SPADLET |wasSimple| + (AND (ATOM |arg|) + (NULL (NUMBERP |arg|)))) + (SPADLET |wasQuotient| (|isQuotient| |op|)) + (SPADLET |wasNumber| (NUMBERP |arg|)) + (SPADLET |firstTime| NIL))))) + |w|))))) ;plusApp([.,frst,:rst],x,y,d) == ; appSum(rst,x+WIDTH frst,y,APP(frst,x,y,d)) -(DEFUN |plusApp| (#0=G167733 |x| |y| |d|) - (PROG (|frst| |rst|) - (RETURN - (PROGN - (SPADLET |frst| (CADR #0#)) - (SPADLET |rst| (CDDR #0#)) - (|appSum| |rst| - (PLUS |x| (WIDTH |frst|)) - |y| - (APP |frst| |x| |y| |d|)))))) +(DEFUN |plusApp| (G167733 |x| |y| |d|) + (PROG (|frst| |rst|) + (RETURN + (PROGN + (SPADLET |frst| (CADR G167733)) + (SPADLET |rst| (CDDR G167733)) + (|appSum| |rst| (PLUS |x| (WIDTH |frst|)) |y| + (APP |frst| |x| |y| |d|)))))) ;appSum(u,x,y,d) == ; for arg in u repeat @@ -2186,35 +2225,38 @@ NIL ; d (DEFUN |appSum| (|u| |x| |y| |d|) - (PROG (|infixOp| |opString| |arg| |rightPrec| |LETTMP#1|) - (RETURN - (SEQ - (PROGN - (DO ((#0=G167771 |u| (CDR #0#)) (|arg| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |arg| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |infixOp| - (COND - ((|syminusp| |arg|) (QUOTE -)) - ((QUOTE T) (QUOTE +)))) - (SPADLET |opString| - (OR (GETL |infixOp| (QUOTE INFIXOP)) (MAKESTRING ","))) - (SPADLET |d| (APP |opString| |x| |y| |d|)) - (SPADLET |x| (PLUS |x| (WIDTH |opString|))) - (SPADLET |arg| (|absym| |arg|)) - (SPADLET |rightPrec| - (|getOpBindingPower| |infixOp| (QUOTE |Led|) (QUOTE |right|))) - (COND - ((BOOT-EQUAL |infixOp| (QUOTE -)) - (SPADLET |rightPrec| (PLUS |rightPrec| 1)))) - (SPADLET |LETTMP#1| - (|appInfixArg| |arg| |x| |y| |d| |rightPrec| (QUOTE |left|) NIL)) - (SPADLET |d| (CAR |LETTMP#1|)) - (SPADLET |x| (CADR |LETTMP#1|)) - |LETTMP#1|)))) - |d|))))) + (PROG (|infixOp| |opString| |rightPrec| |LETTMP#1|) + (RETURN + (SEQ (PROGN + (DO ((G167771 |u| (CDR G167771)) (|arg| NIL)) + ((OR (ATOM G167771) + (PROGN (SETQ |arg| (CAR G167771)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |infixOp| + (COND + ((|syminusp| |arg|) '-) + ('T '+))) + (SPADLET |opString| + (OR (GETL |infixOp| 'INFIXOP) + (MAKESTRING ","))) + (SPADLET |d| (APP |opString| |x| |y| |d|)) + (SPADLET |x| (PLUS |x| (WIDTH |opString|))) + (SPADLET |arg| (|absym| |arg|)) + (SPADLET |rightPrec| + (|getOpBindingPower| |infixOp| + '|Led| '|right|)) + (COND + ((BOOT-EQUAL |infixOp| '-) + (SPADLET |rightPrec| + (PLUS |rightPrec| 1)))) + (SPADLET |LETTMP#1| + (|appInfixArg| |arg| |x| |y| |d| + |rightPrec| '|left| NIL)) + (SPADLET |d| (CAR |LETTMP#1|)) + (SPADLET |x| (CADR |LETTMP#1|)) + |LETTMP#1|)))) + |d|))))) ;appInfix(e,x,y,d) == ; op := keyp e @@ -2239,72 +2281,75 @@ NIL ; d (DEFUN |appInfix| (|e| |x| |y| |d|) - (PROG (|op| |leftPrec| |rightPrec| |opString| |opWidth| |frst| - |rst| |LETTMP#1|) - (RETURN - (SEQ - (PROGN - (SPADLET |op| (|keyp| |e|)) - (SPADLET |leftPrec| - (|getOpBindingPower| |op| (QUOTE |Led|) (QUOTE |left|))) - (COND - ((EQL |leftPrec| 1000) (RETURN NIL)) - ((QUOTE T) - (SPADLET |rightPrec| - (|getOpBindingPower| |op| (QUOTE |Led|) (QUOTE |right|))) - (COND - ((QSLESSP (|#| |e|) 2) - (|throwKeyedMsg| (QUOTE S2IX0008) - (CONS (QUOTE |appInfix|) - (CONS "fewer than 2 arguments to an infix function" NIL)))) - ((QUOTE T) - (SPADLET |opString| (OR (GETL |op| (QUOTE INFIXOP)) (MAKESTRING ","))) - (SPADLET |opWidth| (WIDTH |opString|)) - (SPADLET |frst| (CADR |e|)) - (SPADLET |rst| (CDDR |e|)) - (COND - ((NULL |rst|) - (COND - ((GETL |op| (QUOTE |isSuffix|)) - (SPADLET |LETTMP#1| - (|appInfixArg| |frst| |x| |y| |d| |leftPrec| - (QUOTE |right|) |opString|)) - (SPADLET |d| (CAR |LETTMP#1|)) - (SPADLET |x| (CADR |LETTMP#1|)) - (SPADLET |d| (|appChar| |opString| |x| |y| |d|))) - ((QUOTE T) - (THROW (QUOTE |outputFailure|) (QUOTE |outputFailure|))))) - ((QUOTE T) - (SPADLET |LETTMP#1| - (|appInfixArg| |frst| |x| |y| |d| |leftPrec| - (QUOTE |right|) |opString|)) - (SPADLET |d| (CAR |LETTMP#1|)) - (SPADLET |x| (CADR |LETTMP#1|)) - (DO ((#0=G167827 |rst| (CDR #0#)) (|arg| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |arg| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |d| (|appChar| |opString| |x| |y| |d|)) - (SPADLET |x| (PLUS |x| |opWidth|)) - (SPADLET |LETTMP#1| - (|appInfixArg| |arg| |x| |y| |d| |rightPrec| - (QUOTE |left|) |opString|)) - (SPADLET |d| (CAR |LETTMP#1|)) - (SPADLET |x| (CADR |LETTMP#1|)) - |LETTMP#1|)))) - |d|))))))))))) + (PROG (|op| |leftPrec| |rightPrec| |opString| |opWidth| |frst| |rst| + |LETTMP#1|) + (RETURN + (SEQ (PROGN + (SPADLET |op| (|keyp| |e|)) + (SPADLET |leftPrec| + (|getOpBindingPower| |op| '|Led| '|left|)) + (COND + ((EQL |leftPrec| 1000) (RETURN NIL)) + ('T + (SPADLET |rightPrec| + (|getOpBindingPower| |op| '|Led| '|right|)) + (COND + ((QSLESSP (|#| |e|) 2) + (|throwKeyedMsg| 'S2IX0008 + (CONS '|appInfix| + (CONS "fewer than 2 arguments to an infix function" + NIL)))) + ('T + (SPADLET |opString| + (OR (GETL |op| 'INFIXOP) (MAKESTRING ","))) + (SPADLET |opWidth| (WIDTH |opString|)) + (SPADLET |frst| (CADR |e|)) + (SPADLET |rst| (CDDR |e|)) + (COND + ((NULL |rst|) + (COND + ((GETL |op| '|isSuffix|) + (SPADLET |LETTMP#1| + (|appInfixArg| |frst| |x| |y| |d| + |leftPrec| '|right| |opString|)) + (SPADLET |d| (CAR |LETTMP#1|)) + (SPADLET |x| (CADR |LETTMP#1|)) + (SPADLET |d| + (|appChar| |opString| |x| |y| |d|))) + ('T (THROW '|outputFailure| '|outputFailure|)))) + ('T + (SPADLET |LETTMP#1| + (|appInfixArg| |frst| |x| |y| |d| + |leftPrec| '|right| |opString|)) + (SPADLET |d| (CAR |LETTMP#1|)) + (SPADLET |x| (CADR |LETTMP#1|)) + (DO ((G167827 |rst| (CDR G167827)) (|arg| NIL)) + ((OR (ATOM G167827) + (PROGN (SETQ |arg| (CAR G167827)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |d| + (|appChar| |opString| |x| |y| + |d|)) + (SPADLET |x| (PLUS |x| |opWidth|)) + (SPADLET |LETTMP#1| + (|appInfixArg| |arg| |x| |y| |d| + |rightPrec| '|left| |opString|)) + (SPADLET |d| (CAR |LETTMP#1|)) + (SPADLET |x| (CADR |LETTMP#1|)) + |LETTMP#1|)))) + |d|))))))))))) ;appconc(d,x,y,w) == NCONC(d,[[[x,:y],:w]]) (DEFUN |appconc| (|d| |x| |y| |w|) - (NCONC |d| (CONS (CONS (CONS |x| |y|) |w|) NIL))) + (NCONC |d| (CONS (CONS (CONS |x| |y|) |w|) NIL))) ;infixArgNeedsParens(arg, prec, leftOrRight) == ; prec > getBindingPowerOf(leftOrRight, arg) + 1 (DEFUN |infixArgNeedsParens| (|arg| |prec| |leftOrRight|) - (> |prec| (PLUS (|getBindingPowerOf| |leftOrRight| |arg|) 1))) + (> |prec| (PLUS (|getBindingPowerOf| |leftOrRight| |arg|) 1))) ;appInfixArg(u,x,y,d,prec,leftOrRight,string) == ; insertPrensIfTrue:= infixArgNeedsParens(u,prec,leftOrRight) @@ -2316,19 +2361,21 @@ NIL ; [d,(insertPrensIfTrue => x+2; x)] (DEFUN |appInfixArg| (|u| |x| |y| |d| |prec| |leftOrRight| |string|) - (PROG (|insertPrensIfTrue|) - (RETURN - (PROGN - (SPADLET |insertPrensIfTrue| - (|infixArgNeedsParens| |u| |prec| |leftOrRight|)) - (SPADLET |d| - (COND - (|insertPrensIfTrue| (|appparu| |u| |x| |y| |d|)) - ((QUOTE T) (APP |u| |x| |y| |d|)))) - (SPADLET |x| (PLUS |x| (WIDTH |u|))) - (COND (|string| (SPADLET |d| (|appconc| |d| |x| |y| |string|)))) - (CONS |d| - (CONS (COND (|insertPrensIfTrue| (PLUS |x| 2)) ((QUOTE T) |x|)) NIL)))))) + (PROG (|insertPrensIfTrue|) + (RETURN + (PROGN + (SPADLET |insertPrensIfTrue| + (|infixArgNeedsParens| |u| |prec| |leftOrRight|)) + (SPADLET |d| + (COND + (|insertPrensIfTrue| (|appparu| |u| |x| |y| |d|)) + ('T (APP |u| |x| |y| |d|)))) + (SPADLET |x| (PLUS |x| (WIDTH |u|))) + (COND + (|string| (SPADLET |d| (|appconc| |d| |x| |y| |string|)))) + (CONS |d| + (CONS (COND (|insertPrensIfTrue| (PLUS |x| 2)) ('T |x|)) + NIL)))))) ;getBindingPowerOf(key,x) == ; --binding powers can be found in file NEWAUX LISP @@ -2352,63 +2399,60 @@ NIL ; 1002 (DEFUN |getBindingPowerOf| (|key| |x|) - (PROG (|argl| |a| |op| |n| |m|) - (RETURN - (COND - ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE REDUCE))) - (COND - ((BOOT-EQUAL |key| (QUOTE |left|)) 130) - ((BOOT-EQUAL |key| (QUOTE |right|)) 0))) - ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE REPEAT))) - (COND - ((BOOT-EQUAL |key| (QUOTE |left|)) 130) - ((BOOT-EQUAL |key| (QUOTE |right|)) 0))) - ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE COND))) - (COND - ((BOOT-EQUAL |key| (QUOTE |left|)) 130) - ((BOOT-EQUAL |key| (QUOTE |right|)) 0))) - ((AND (PAIRP |x|) - (PROGN - (SPADLET |op| (QCAR |x|)) - (SPADLET |argl| (QCDR |x|)) - (QUOTE T))) - (COND - ((AND (PAIRP |op|) (PROGN (SPADLET |a| (QCAR |op|)) (QUOTE T))) - (SPADLET |op| |a|))) - (COND - ((BOOT-EQUAL |op| (QUOTE SLASH)) - (SPADDIFFERENCE (|getBindingPowerOf| |key| (CONS (QUOTE /) |argl|)) 1)) - ((BOOT-EQUAL |op| (QUOTE OVER)) - (|getBindingPowerOf| |key| (CONS (QUOTE /) |argl|))) - ((EQL (SPADLET |n| (|#| |argl|)) 1) - (COND - ((AND - (BOOT-EQUAL |key| (QUOTE |left|)) - (SPADLET |m| - (|getOpBindingPower| |op| (QUOTE |Nud|) (QUOTE |left|)))) - |m|) - ((AND - (BOOT-EQUAL |key| (QUOTE |right|)) - (SPADLET |m| - (|getOpBindingPower| |op| (QUOTE |Nud|) (QUOTE |right|)))) - |m|) - ((QUOTE T) 1000))) - ((> |n| 1) - (COND - ((AND - (BOOT-EQUAL |key| (QUOTE |left|)) - (SPADLET |m| - (|getOpBindingPower| |op| (QUOTE |Led|) (QUOTE |left|)))) - |m|) - ((AND - (BOOT-EQUAL |key| (QUOTE |right|)) - (SPADLET |m| - (|getOpBindingPower| |op| (QUOTE |Led|) (QUOTE |right|)))) - |m|) - ((BOOT-EQUAL |op| (QUOTE ELT)) 1002) - ((QUOTE T) 1000))) - ((QUOTE T) 1000))) - ((QUOTE T) 1002))))) + (PROG (|argl| |a| |op| |n| |m|) + (RETURN + (COND + ((AND (PAIRP |x|) (EQ (QCAR |x|) 'REDUCE)) + (COND + ((BOOT-EQUAL |key| '|left|) 130) + ((BOOT-EQUAL |key| '|right|) 0))) + ((AND (PAIRP |x|) (EQ (QCAR |x|) 'REPEAT)) + (COND + ((BOOT-EQUAL |key| '|left|) 130) + ((BOOT-EQUAL |key| '|right|) 0))) + ((AND (PAIRP |x|) (EQ (QCAR |x|) 'COND)) + (COND + ((BOOT-EQUAL |key| '|left|) 130) + ((BOOT-EQUAL |key| '|right|) 0))) + ((AND (PAIRP |x|) + (PROGN + (SPADLET |op| (QCAR |x|)) + (SPADLET |argl| (QCDR |x|)) + 'T)) + (COND + ((AND (PAIRP |op|) (PROGN (SPADLET |a| (QCAR |op|)) 'T)) + (SPADLET |op| |a|))) + (COND + ((BOOT-EQUAL |op| 'SLASH) + (SPADDIFFERENCE + (|getBindingPowerOf| |key| (CONS '/ |argl|)) 1)) + ((BOOT-EQUAL |op| 'OVER) + (|getBindingPowerOf| |key| (CONS '/ |argl|))) + ((EQL (SPADLET |n| (|#| |argl|)) 1) + (COND + ((AND (BOOT-EQUAL |key| '|left|) + (SPADLET |m| + (|getOpBindingPower| |op| '|Nud| '|left|))) + |m|) + ((AND (BOOT-EQUAL |key| '|right|) + (SPADLET |m| + (|getOpBindingPower| |op| '|Nud| '|right|))) + |m|) + ('T 1000))) + ((> |n| 1) + (COND + ((AND (BOOT-EQUAL |key| '|left|) + (SPADLET |m| + (|getOpBindingPower| |op| '|Led| '|left|))) + |m|) + ((AND (BOOT-EQUAL |key| '|right|) + (SPADLET |m| + (|getOpBindingPower| |op| '|Led| '|right|))) + |m|) + ((BOOT-EQUAL |op| 'ELT) 1002) + ('T 1000))) + ('T 1000))) + ('T 1002))))) ;getOpBindingPower(op,LedOrNud,leftOrRight) == ; if op in '(SLASH OVER) then op := "/" @@ -2422,23 +2466,20 @@ NIL ; 1000 (DEFUN |getOpBindingPower| (|op| |LedOrNud| |leftOrRight|) - (PROG (|exception| |bp|) - (RETURN - (PROGN - (COND ((|member| |op| (QUOTE (SLASH OVER))) (SPADLET |op| (QUOTE /)))) - (SPADLET |exception| - (COND - ((BOOT-EQUAL |leftOrRight| (QUOTE |left|)) 0) - ((QUOTE T) 105))) - (SPADLET |bp| - (COND - ((BOOT-EQUAL |leftOrRight| (QUOTE |left|)) - (|leftBindingPowerOf| |op| |LedOrNud|)) - ((QUOTE T) - (|rightBindingPowerOf| |op| |LedOrNud|)))) - (COND - ((NEQUAL |bp| |exception|) |bp|) - ((QUOTE T) 1000)))))) + (PROG (|exception| |bp|) + (RETURN + (PROGN + (COND ((|member| |op| '(SLASH OVER)) (SPADLET |op| '/))) + (SPADLET |exception| + (COND + ((BOOT-EQUAL |leftOrRight| '|left|) 0) + ('T 105))) + (SPADLET |bp| + (COND + ((BOOT-EQUAL |leftOrRight| '|left|) + (|leftBindingPowerOf| |op| |LedOrNud|)) + ('T (|rightBindingPowerOf| |op| |LedOrNud|)))) + (COND ((NEQUAL |bp| |exception|) |bp|) ('T 1000)))))) ;--% Brackets ;bracketApp(u,x,y,d) == @@ -2448,25 +2489,19 @@ NIL ; appChar(specialChar 'rbrk,x+1+WIDTH u,y,d) (DEFUN |bracketApp| (|u| |x| |y| |d|) - (PROG (|ISTMP#1|) - (RETURN - (PROGN - (OR - (AND (PAIRP |u|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |u|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |u| (QCAR |ISTMP#1|)) (QUOTE T))))) - (THROW (QUOTE |outputFailure|) (QUOTE |outputFailure|))) - (SPADLET |d| (|appChar| (|specialChar| (QUOTE |lbrk|)) |x| |y| |d|)) - (SPADLET |d| (APP |u| (PLUS |x| 1) |y| |d|)) - (|appChar| - (|specialChar| (QUOTE |rbrk|)) - (PLUS (PLUS |x| 1) (WIDTH |u|)) - |y| - |d|))))) + (PROG (|ISTMP#1|) + (RETURN + (PROGN + (OR (AND (PAIRP |u|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |u|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |u| (QCAR |ISTMP#1|)) 'T)))) + (THROW '|outputFailure| '|outputFailure|)) + (SPADLET |d| (|appChar| (|specialChar| '|lbrk|) |x| |y| |d|)) + (SPADLET |d| (APP |u| (PLUS |x| 1) |y| |d|)) + (|appChar| (|specialChar| '|rbrk|) + (PLUS (PLUS |x| 1) (WIDTH |u|)) |y| |d|))))) ;--% Braces ;braceApp(u,x,y,d) == @@ -2476,25 +2511,19 @@ NIL ; appChar(specialChar 'rbrc,x+1+WIDTH u,y,d) (DEFUN |braceApp| (|u| |x| |y| |d|) - (PROG (|ISTMP#1|) - (RETURN - (PROGN - (OR - (AND (PAIRP |u|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |u|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |u| (QCAR |ISTMP#1|)) (QUOTE T))))) - (THROW (QUOTE |outputFailure|) (QUOTE |outputFailure|))) - (SPADLET |d| (|appChar| (|specialChar| (QUOTE |lbrc|)) |x| |y| |d|)) - (SPADLET |d| (APP |u| (PLUS |x| 1) |y| |d|)) - (|appChar| - (|specialChar| (QUOTE |rbrc|)) - (PLUS (PLUS |x| 1) (WIDTH |u|)) - |y| - |d|))))) + (PROG (|ISTMP#1|) + (RETURN + (PROGN + (OR (AND (PAIRP |u|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |u|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |u| (QCAR |ISTMP#1|)) 'T)))) + (THROW '|outputFailure| '|outputFailure|)) + (SPADLET |d| (|appChar| (|specialChar| '|lbrc|) |x| |y| |d|)) + (SPADLET |d| (APP |u| (PLUS |x| 1) |y| |d|)) + (|appChar| (|specialChar| '|rbrc|) + (PLUS (PLUS |x| 1) (WIDTH |u|)) |y| |d|))))) ;--% Aggregates ;aggWidth u == @@ -2502,40 +2531,41 @@ NIL ; 0 (DEFUN |aggWidth| (|u|) - (PROG (|ISTMP#1| |a| |l|) - (RETURN - (SEQ - (COND - ((PROGN - (SPADLET |ISTMP#1| (CDR |u|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |a| (QCAR |ISTMP#1|)) - (SPADLET |l| (QCDR |ISTMP#1|)) - (QUOTE T)))) - (PLUS - (WIDTH |a|) - (PROG (#0=G167935) - (SPADLET #0# 0) - (RETURN - (DO ((#1=G167940 |l| (CDR #1#)) (|x| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) #0#) - (SEQ (EXIT (SETQ #0# (PLUS #0# (PLUS 1 (WIDTH |x|))))))))))) - ((QUOTE T) 0)))))) + (PROG (|ISTMP#1| |a| |l|) + (RETURN + (SEQ (COND + ((PROGN + (SPADLET |ISTMP#1| (CDR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |a| (QCAR |ISTMP#1|)) + (SPADLET |l| (QCDR |ISTMP#1|)) + 'T))) + (PLUS (WIDTH |a|) + (PROG (G167935) + (SPADLET G167935 0) + (RETURN + (DO ((G167940 |l| (CDR G167940)) (|x| NIL)) + ((OR (ATOM G167940) + (PROGN (SETQ |x| (CAR G167940)) NIL)) + G167935) + (SEQ (EXIT (SETQ G167935 + (PLUS G167935 + (PLUS 1 (WIDTH |x|))))))))))) + ('T 0)))))) ;aggSub u == subspan rest u -(DEFUN |aggSub| (|u|) (|subspan| (CDR |u|))) +(DEFUN |aggSub| (|u|) (|subspan| (CDR |u|))) ;aggSuper u == superspan rest u -(DEFUN |aggSuper| (|u|) (|superspan| (CDR |u|))) +(DEFUN |aggSuper| (|u|) (|superspan| (CDR |u|))) ;aggApp(u,x,y,d) == aggregateApp(rest u,x,y,d,",") (DEFUN |aggApp| (|u| |x| |y| |d|) - (|aggregateApp| (CDR |u|) |x| |y| |d| (QUOTE |,|))) + (|aggregateApp| (CDR |u|) |x| |y| |d| '|,|)) ;aggregateApp(u,x,y,d,s) == ; if u is [a,:l] then @@ -2548,27 +2578,28 @@ NIL ; d (DEFUN |aggregateApp| (|u| |x| |y| |d| |s|) - (PROG (|a| |l|) - (RETURN - (SEQ - (PROGN - (COND - ((AND (PAIRP |u|) - (PROGN - (SPADLET |a| (QCAR |u|)) - (SPADLET |l| (QCDR |u|)) - (QUOTE T))) - (SPADLET |d| (APP |a| |x| |y| |d|)) - (SPADLET |x| (PLUS |x| (WIDTH |a|))) - (DO ((#0=G167974 |l| (CDR #0#)) (|b| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |b| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |d| (APP |s| |x| |y| |d|)) - (SPADLET |d| (APP |b| (PLUS |x| 1) |y| |d|)) - (SPADLET |x| (PLUS (PLUS |x| 1) (WIDTH |b|))))))))) - |d|))))) + (PROG (|a| |l|) + (RETURN + (SEQ (PROGN + (COND + ((AND (PAIRP |u|) + (PROGN + (SPADLET |a| (QCAR |u|)) + (SPADLET |l| (QCDR |u|)) + 'T)) + (SPADLET |d| (APP |a| |x| |y| |d|)) + (SPADLET |x| (PLUS |x| (WIDTH |a|))) + (DO ((G167974 |l| (CDR G167974)) (|b| NIL)) + ((OR (ATOM G167974) + (PROGN (SETQ |b| (CAR G167974)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |d| (APP |s| |x| |y| |d|)) + (SPADLET |d| + (APP |b| (PLUS |x| 1) |y| |d|)) + (SPADLET |x| + (PLUS (PLUS |x| 1) (WIDTH |b|))))))))) + |d|))))) ;--% Function to compute Width ;outformWidth u == --WIDTH as called from OUTFORM to do a COPY @@ -2580,19 +2611,18 @@ NIL ; WIDTH COPY u (DEFUN |outformWidth| (|u|) - (COND - ((STRINGP |u|) - (COND - ((BOOT-EQUAL |u| |$EmptyString|) 0) - ((AND - (BOOT-EQUAL (ELT |u| 0) (QUOTE %)) - (OR - (BOOT-EQUAL (ELT |u| 1) (|char| (QUOTE |b|))) - (BOOT-EQUAL (ELT |u| 1) (|char| (QUOTE |d|))))) - 1) - ((QUOTE T) (|#| |u|)))) - ((ATOM |u|) (|#| (|atom2String| |u|))) - ((QUOTE T) (WIDTH (COPY |u|))))) + (DECLARE (SPECIAL |$EmptyString|)) + (COND + ((STRINGP |u|) + (COND + ((BOOT-EQUAL |u| |$EmptyString|) 0) + ((AND (BOOT-EQUAL (ELT |u| 0) '%) + (OR (BOOT-EQUAL (ELT |u| 1) (|char| '|b|)) + (BOOT-EQUAL (ELT |u| 1) (|char| '|d|)))) + 1) + ('T (|#| |u|)))) + ((ATOM |u|) (|#| (|atom2String| |u|))) + ('T (WIDTH (COPY |u|))))) ;WIDTH u == ; STRINGP u => @@ -2611,39 +2641,36 @@ NIL ; THROW('outputFailure,'outputFailure) (DEFUN WIDTH (|u|) - (PROG (|negative| |ISTMP#1| |ISTMP#2| |n|) - (RETURN - (COND - ((STRINGP |u|) - (COND - ((BOOT-EQUAL |u| |$EmptyString|) 0) - ((AND - (BOOT-EQUAL (ELT |u| 0) (QUOTE %)) - (OR - (BOOT-EQUAL (ELT |u| 1) (|char| (QUOTE |b|))) - (BOOT-EQUAL (ELT |u| 1) (|char| (QUOTE |d|))))) - 1) - ((QUOTE T) (|#| |u|)))) - ((INTEGERP |u|) - (COND - ((EQL |u| 0) 1) - ((QUOTE T) - (COND - ((> 1 |u|) (SPADLET |negative| 1)) - ((QUOTE T) (SPADLET |negative| 0))) - (PLUS (DIGITS-BY-RADIX |u| 10) |negative|)))) - ((ATOM |u|) (|#| (|atom2String| |u|))) - ((PROGN - (SPADLET |ISTMP#1| (|putWidth| |u|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (PROGN (SPADLET |n| (QCDR |ISTMP#2|)) (QUOTE T)))))) - |n|) - ((QUOTE T) (THROW (QUOTE |outputFailure|) (QUOTE |outputFailure|))))))) + (PROG (|negative| |ISTMP#1| |ISTMP#2| |n|) + (DECLARE (SPECIAL |$EmptyString|)) + (RETURN + (COND + ((STRINGP |u|) + (COND + ((BOOT-EQUAL |u| |$EmptyString|) 0) + ((AND (BOOT-EQUAL (ELT |u| 0) '%) + (OR (BOOT-EQUAL (ELT |u| 1) (|char| '|b|)) + (BOOT-EQUAL (ELT |u| 1) (|char| '|d|)))) + 1) + ('T (|#| |u|)))) + ((INTEGERP |u|) + (COND + ((EQL |u| 0) 1) + ('T + (COND + ((> 1 |u|) (SPADLET |negative| 1)) + ('T (SPADLET |negative| 0))) + (PLUS (DIGITS-BY-RADIX |u| 10) |negative|)))) + ((ATOM |u|) (|#| (|atom2String| |u|))) + ((PROGN + (SPADLET |ISTMP#1| (|putWidth| |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN (SPADLET |n| (QCDR |ISTMP#2|)) 'T))))) + |n|) + ('T (THROW '|outputFailure| '|outputFailure|)))))) ;putWidth u == ; atom u or u is [[.,:n],:.] and NUMBERP n => u @@ -2679,83 +2706,90 @@ NIL ; u (DEFUN |putWidth| (|u|) - (PROG (|ISTMP#1| |n| |op| |leftPrec| |rightPrec| |firstEl| |l| |interSpace| - |firstArg| |restArg| |widthFirstArg| |argsWidth| |oldFirst| |fn| - |ll| |newFirst|) - (RETURN - (SEQ - (COND - ((OR (ATOM |u|) - (AND - (PAIRP |u|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |u|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN (SPADLET |n| (QCDR |ISTMP#1|)) (QUOTE T)))) - (NUMBERP |n|))) - |u|) - ((QUOTE T) - (SPADLET |op| (|keyp| |u|)) - (SPADLET |leftPrec| (|getBindingPowerOf| (QUOTE |left|) |u|)) - (SPADLET |rightPrec| (|getBindingPowerOf| (QUOTE |right|) |u|)) - (SPADLET |firstEl| (CAR |u|)) - (SPADLET |l| (CDR |u|)) - (SPADLET |interSpace| - (COND - ((GETL |firstEl| (QUOTE INFIXOP)) 0) - ((QUOTE T) 1))) - (SPADLET |argsWidth| - (COND - ((AND (PAIRP |l|) - (PROGN - (SPADLET |firstArg| (QCAR |l|)) - (SPADLET |restArg| (QCDR |l|)) - (QUOTE T))) - (RPLACA (CDR |u|) (|putWidth| |firstArg|)) - (DO ((|y| |restArg| (CDR |y|))) - ((ATOM |y|) NIL) - (SEQ (EXIT (RPLACA |y| (|putWidth| (CAR |y|)))))) - (SPADLET |widthFirstArg| - (COND - ((AND - (EQL 0 |interSpace|) - (|infixArgNeedsParens| |firstArg| |leftPrec| (QUOTE |right|))) - (PLUS 2 (WIDTH |firstArg|))) - ((QUOTE T) (WIDTH |firstArg|)))) - (PLUS |widthFirstArg| - (PROG (#0=G168041) - (SPADLET #0# 0) - (RETURN - (DO ((#1=G168046 |restArg| (CDR #1#)) (|x| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) #0#) - (SEQ - (EXIT - (SETQ #0# - (PLUS #0# - (PLUS |interSpace| - (COND - ((AND - (EQL 0 |interSpace|) - (|infixArgNeedsParens| |x| |rightPrec| (QUOTE |left|))) - (PLUS 2 (WIDTH |x|))) - ((QUOTE T) (WIDTH |x|))))))))))))) - ((QUOTE T) 0))) - (SPADLET |newFirst| - (COND - ((ATOM (SPADLET |oldFirst| (CAR |u|))) - (COND - ((SPADLET |fn| (GETL |oldFirst| (QUOTE WIDTH))) - (CONS |oldFirst| (FUNCALL |fn| (CONS |oldFirst| |l|)))) - ((QUOTE T) - (COND (|l| (SPADLET |ll| (CDR |l|))) ((QUOTE T) (SPADLET |ll| NIL))) - (CONS |oldFirst| (PLUS (|opWidth| |oldFirst| |ll|) |argsWidth|))))) - ((QUOTE T) - (CONS - (|putWidth| |oldFirst|) - (PLUS (PLUS 2 (WIDTH |oldFirst|)) |argsWidth|))))) - (RPLACA |u| |newFirst|) - |u|)))))) + (PROG (|ISTMP#1| |n| |op| |leftPrec| |rightPrec| |firstEl| |l| + |interSpace| |firstArg| |restArg| |widthFirstArg| + |argsWidth| |oldFirst| |fn| |ll| |newFirst|) + (RETURN + (SEQ (COND + ((OR (ATOM |u|) + (AND (PAIRP |u|) + (PROGN + (SPADLET |ISTMP#1| (QCAR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |n| (QCDR |ISTMP#1|)) + 'T))) + (NUMBERP |n|))) + |u|) + ('T (SPADLET |op| (|keyp| |u|)) + (SPADLET |leftPrec| (|getBindingPowerOf| '|left| |u|)) + (SPADLET |rightPrec| (|getBindingPowerOf| '|right| |u|)) + (SPADLET |firstEl| (CAR |u|)) (SPADLET |l| (CDR |u|)) + (SPADLET |interSpace| + (COND ((GETL |firstEl| 'INFIXOP) 0) ('T 1))) + (SPADLET |argsWidth| + (COND + ((AND (PAIRP |l|) + (PROGN + (SPADLET |firstArg| (QCAR |l|)) + (SPADLET |restArg| (QCDR |l|)) + 'T)) + (RPLACA (CDR |u|) (|putWidth| |firstArg|)) + (DO ((|y| |restArg| (CDR |y|))) + ((ATOM |y|) NIL) + (SEQ (EXIT (RPLACA |y| + (|putWidth| (CAR |y|)))))) + (SPADLET |widthFirstArg| + (COND + ((AND (EQL 0 |interSpace|) + (|infixArgNeedsParens| + |firstArg| |leftPrec| '|right|)) + (PLUS 2 (WIDTH |firstArg|))) + ('T (WIDTH |firstArg|)))) + (PLUS |widthFirstArg| + (PROG (G168041) + (SPADLET G168041 0) + (RETURN + (DO + ((G168046 |restArg| (CDR G168046)) + (|x| NIL)) + ((OR (ATOM G168046) + (PROGN + (SETQ |x| (CAR G168046)) + NIL)) + G168041) + (SEQ + (EXIT + (SETQ G168041 + (PLUS G168041 + (PLUS |interSpace| + (COND + ((AND (EQL 0 |interSpace|) + (|infixArgNeedsParens| + |x| |rightPrec| + '|left|)) + (PLUS 2 (WIDTH |x|))) + ('T (WIDTH |x|))))))))))))) + ('T 0))) + (SPADLET |newFirst| + (COND + ((ATOM (SPADLET |oldFirst| (CAR |u|))) + (COND + ((SPADLET |fn| (GETL |oldFirst| 'WIDTH)) + (CONS |oldFirst| + (FUNCALL |fn| (CONS |oldFirst| |l|)))) + ('T + (COND + (|l| (SPADLET |ll| (CDR |l|))) + ('T (SPADLET |ll| NIL))) + (CONS |oldFirst| + (PLUS (|opWidth| |oldFirst| |ll|) + |argsWidth|))))) + ('T + (CONS (|putWidth| |oldFirst|) + (PLUS (PLUS 2 (WIDTH |oldFirst|)) + |argsWidth|))))) + (RPLACA |u| |newFirst|) |u|)))))) ;opWidth(op,has2Arguments) == ; op = "EQUATNUM" => 4 @@ -2767,17 +2801,17 @@ NIL ; 2+SIZE PNAME op (DEFUN |opWidth| (|op| |has2Arguments|) - (PROG (|a|) - (RETURN - (COND - ((BOOT-EQUAL |op| (QUOTE EQUATNUM)) 4) - ((NUMBERP |op|) (PLUS 2 (SIZE (STRINGIMAGE |op|)))) - ((NULL |has2Arguments|) - (COND - ((SPADLET |a| (GETL |op| (QUOTE PREFIXOP))) (SIZE |a|)) - ((QUOTE T) (PLUS 2 (SIZE (PNAME |op|)))))) - ((SPADLET |a| (GETL |op| (QUOTE INFIXOP))) (SIZE |a|)) - ((QUOTE T) (PLUS 2 (SIZE (PNAME |op|)))))))) + (PROG (|a|) + (RETURN + (COND + ((BOOT-EQUAL |op| 'EQUATNUM) 4) + ((NUMBERP |op|) (PLUS 2 (SIZE (STRINGIMAGE |op|)))) + ((NULL |has2Arguments|) + (COND + ((SPADLET |a| (GETL |op| 'PREFIXOP)) (SIZE |a|)) + ('T (PLUS 2 (SIZE (PNAME |op|)))))) + ((SPADLET |a| (GETL |op| 'INFIXOP)) (SIZE |a|)) + ('T (PLUS 2 (SIZE (PNAME |op|)))))))) ;matrixBorder(x,y1,y2,d,leftOrRight) == ; y1 = y2 => @@ -2798,56 +2832,55 @@ NIL ; d (DEFUN |matrixBorder| (|x| |y1| |y2| |d| |leftOrRight|) - (PROG (|c|) - (RETURN - (SEQ - (COND - ((BOOT-EQUAL |y1| |y2|) - (SPADLET |c| - (COND - ((BOOT-EQUAL |leftOrRight| (QUOTE |left|)) - (|specialChar| (QUOTE |lbrk|))) - ((QUOTE T) - (|specialChar| (QUOTE |rbrk|))))) - (APP |c| |x| |y1| |d|)) - ((QUOTE T) - (DO ((|y| |y1| (+ |y| 1))) - ((> |y| |y2|) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |c| - (COND - ((BOOT-EQUAL |y| |y1|) - (COND - ((BOOT-EQUAL |leftOrRight| (QUOTE |left|)) - (|specialChar| (QUOTE |llc|))) - ((QUOTE T) - (|specialChar| (QUOTE |lrc|))))) - ((BOOT-EQUAL |y| |y2|) - (COND - ((BOOT-EQUAL |leftOrRight| (QUOTE |left|)) - (|specialChar| (QUOTE |ulc|))) - ((QUOTE T) - (|specialChar| (QUOTE |urc|))))) - ((QUOTE T) (|specialChar| (QUOTE |vbar|))))) - (SPADLET |d| (APP |c| |x| |y| |d|)))))) - |d|)))))) + (PROG (|c|) + (RETURN + (SEQ (COND + ((BOOT-EQUAL |y1| |y2|) + (SPADLET |c| + (COND + ((BOOT-EQUAL |leftOrRight| '|left|) + (|specialChar| '|lbrk|)) + ('T (|specialChar| '|rbrk|)))) + (APP |c| |x| |y1| |d|)) + ('T + (DO ((|y| |y1| (+ |y| 1))) ((> |y| |y2|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |c| + (COND + ((BOOT-EQUAL |y| |y1|) + (COND + ((BOOT-EQUAL |leftOrRight| + '|left|) + (|specialChar| '|llc|)) + ('T (|specialChar| '|lrc|)))) + ((BOOT-EQUAL |y| |y2|) + (COND + ((BOOT-EQUAL |leftOrRight| + '|left|) + (|specialChar| '|ulc|)) + ('T (|specialChar| '|urc|)))) + ('T (|specialChar| '|vbar|)))) + (SPADLET |d| (APP |c| |x| |y| |d|)))))) + |d|)))))) ;isRationalNumber x == nil -(DEFUN |isRationalNumber| (|x|) NIL) +(DEFUN |isRationalNumber| (|x|) + (declare (ignore |x|)) + NIL) ;widthSC u == 10000 -(DEFUN |widthSC| (|u|) 10000) +(DEFUN |widthSC| (|u|) + (declare (ignore |u|)) + 10000) ;--% The over-large matrix package ;maprinSpecial(x,$MARGIN,$LINELENGTH) == maprin0 x (DEFUN |maprinSpecial| (|x| $MARGIN $LINELENGTH) - (DECLARE (SPECIAL $MARGIN $LINELENGTH)) - (|maprin0| |x|)) + (DECLARE (SPECIAL $MARGIN $LINELENGTH)) + (|maprin0| |x|)) ;maprin x == ; if $demoFlag=true then recordOrCompareDemoResult x @@ -2855,9 +2888,12 @@ NIL ; nil (DEFUN |maprin| (|x|) - (PROGN - (COND ((BOOT-EQUAL |$demoFlag| (QUOTE T)) (|recordOrCompareDemoResult| |x|))) - (CATCH (QUOTE |output|) (|maprin0| |x|)) NIL)) + (DECLARE (SPECIAL |$demoFlag|)) + (PROGN + (COND + ((BOOT-EQUAL |$demoFlag| 'T) (|recordOrCompareDemoResult| |x|))) + (CATCH '|output| (|maprin0| |x|)) + NIL)) ;maprin0 x == ; $MatrixCount:local :=0 @@ -2866,14 +2902,14 @@ NIL ; if $MatrixList then maprinRows $MatrixList (DEFUN |maprin0| (|x|) - (PROG (|$MatrixCount| |$MatrixList|) - (DECLARE (SPECIAL |$MatrixCount| |$MatrixList|)) - (RETURN - (PROGN - (SPADLET |$MatrixCount| 0) - (SPADLET |$MatrixList| NIL) - (|maprinChk| |x|) - (COND (|$MatrixList| (|maprinRows| |$MatrixList|)) ((QUOTE T) NIL)))))) + (PROG (|$MatrixCount| |$MatrixList|) + (DECLARE (SPECIAL |$MatrixCount| |$MatrixList|)) + (RETURN + (PROGN + (SPADLET |$MatrixCount| 0) + (SPADLET |$MatrixList| NIL) + (|maprinChk| |x|) + (COND (|$MatrixList| (|maprinRows| |$MatrixList|)) ('T NIL)))))) ;maprinChk x == ; null $MatrixList => maPrin x @@ -2905,69 +2941,62 @@ NIL ; maPrin x (DEFUN |maprinChk| (|x|) - (PROG (|arg| |n| |ISTMP#2| |y| |ISTMP#1| |name| |value| |u|) - (RETURN - (COND - ((NULL |$MatrixList|) (|maPrin| |x|)) - ((AND (ATOM |x|) (SPADLET |u| (|assoc| |x| |$MatrixList|))) - (SPADLET |$MatrixList| (|delete| |u| |$MatrixList|)) - (|maPrin| (|deMatrix| (CDR |u|)))) - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE =)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |arg| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (COND - ((SPADLET |u| (|assoc| |y| |$MatrixList|)) - (SPADLET |$MatrixList| (|delete| |u| |$MatrixList|)) - (|maPrin| - (CONS (QUOTE =) (CONS |arg| (CONS (|deMatrix| (CDR |u|)) NIL))))) - ((QUOTE T) (|maPrin| |x|)))) - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE EQUATNUM)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |n| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (COND - ((AND (PAIRP |$MatrixList|) - (EQ (QCDR |$MatrixList|) NIL) - (PROGN - (SPADLET |ISTMP#1| (QCAR |$MatrixList|)) - (AND - (PAIRP |ISTMP#1|) + (PROG (|arg| |n| |ISTMP#2| |y| |ISTMP#1| |name| |value| |u|) + (DECLARE (SPECIAL |$algebraOutputStream| |$collectOutput| + |$MatrixList|)) + (RETURN + (COND + ((NULL |$MatrixList|) (|maPrin| |x|)) + ((AND (ATOM |x|) (SPADLET |u| (|assoc| |x| |$MatrixList|))) + (SPADLET |$MatrixList| (|delete| |u| |$MatrixList|)) + (|maPrin| (|deMatrix| (CDR |u|)))) + ((AND (PAIRP |x|) (EQ (QCAR |x|) '=) (PROGN - (SPADLET |name| (QCAR |ISTMP#1|)) - (SPADLET |value| (QCDR |ISTMP#1|)) - (QUOTE T)))) - (BOOT-EQUAL |y| |name|)) - (SPADLET |$MatrixList| NIL) - (|maPrin| - (CONS (QUOTE EQUATNUM) (CONS |n| (CONS (|deMatrix| |value|) NIL))))) - ((IDENTP |y|) - (SPADLET |u| (|assoc| |y| |$MatrixList|)) - (SPADLET |$MatrixList| (|delete| |u| |$MatrixList|)) - (|maPrin| (CONS (QUOTE EQUATNUM) (CONS |n| (CONS (CDR |u|) NIL)))) - (COND - ((NULL |$collectOutput|) (TERPRI |$algebraOutputStream|)) - ((QUOTE T) NIL))) - ((QUOTE T) (|maPrin| |x|)))) - ((QUOTE T) (|maPrin| |x|)))))) + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |arg| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) 'T)))))) + (COND + ((SPADLET |u| (|assoc| |y| |$MatrixList|)) + (SPADLET |$MatrixList| (|delete| |u| |$MatrixList|)) + (|maPrin| + (CONS '= + (CONS |arg| (CONS (|deMatrix| (CDR |u|)) NIL))))) + ('T (|maPrin| |x|)))) + ((AND (PAIRP |x|) (EQ (QCAR |x|) 'EQUATNUM) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |n| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) 'T)))))) + (COND + ((AND (PAIRP |$MatrixList|) (EQ (QCDR |$MatrixList|) NIL) + (PROGN + (SPADLET |ISTMP#1| (QCAR |$MatrixList|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |name| (QCAR |ISTMP#1|)) + (SPADLET |value| (QCDR |ISTMP#1|)) + 'T))) + (BOOT-EQUAL |y| |name|)) + (SPADLET |$MatrixList| NIL) + (|maPrin| + (CONS 'EQUATNUM + (CONS |n| (CONS (|deMatrix| |value|) NIL))))) + ((IDENTP |y|) (SPADLET |u| (|assoc| |y| |$MatrixList|)) + (SPADLET |$MatrixList| (|delete| |u| |$MatrixList|)) + (|maPrin| (CONS 'EQUATNUM (CONS |n| (CONS (CDR |u|) NIL)))) + (COND + ((NULL |$collectOutput|) (TERPRI |$algebraOutputStream|)) + ('T NIL))) + ('T (|maPrin| |x|)))) + ('T (|maPrin| |x|)))))) ;maprinRows matrixList == ; if ^$collectOutput then TERPRI($algebraOutputStream) @@ -2983,42 +3012,49 @@ NIL ; maprinChk ["=",line,m] (DEFUN |maprinRows| (|matrixList|) - (PROG (|y| |firstName| |name| |m| |andWhere| |line|) - (RETURN - (SEQ - (PROGN - (COND ((NULL |$collectOutput|) (TERPRI |$algebraOutputStream|))) - (DO () - ((NULL |matrixList|) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |y| (NREVERSE |matrixList|)) - (SPADLET |matrixList| NIL) - (SPADLET |firstName| (CAR (CAR |y|))) - (DO ((#0=G168227 |y| (CDR #0#)) - (#1=G168195 NIL) - (|n| 0 (QSADD1 |n|))) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN - (SPADLET |name| (CAR #1#)) - (SPADLET |m| (CDR #1#)) - #1#) - NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (COND ((NULL |$collectOutput|) (TERPRI |$algebraOutputStream|))) - (SPADLET |andWhere| - (COND - ((BOOT-EQUAL |name| |firstName|) (MAKESTRING "where ")) - ((QUOTE T) (MAKESTRING "and ")))) - (SPADLET |line| (STRCONC |andWhere| (PNAME |name|))) - (|maprinChk| - (CONS (QUOTE =) (CONS |line| (CONS |m| NIL))))))))))))))))) + (PROG (|y| |firstName| |name| |m| |andWhere| |line|) + (DECLARE (SPECIAL |$algebraOutputStream| |$collectOutput|)) + (RETURN + (SEQ (PROGN + (COND + ((NULL |$collectOutput|) + (TERPRI |$algebraOutputStream|))) + (DO () ((NULL |matrixList|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |y| (NREVERSE |matrixList|)) + (SPADLET |matrixList| NIL) + (SPADLET |firstName| (CAR (CAR |y|))) + (DO ((G168227 |y| (CDR G168227)) + (G168195 NIL) (|n| 0 (QSADD1 |n|))) + ((OR (ATOM G168227) + (PROGN + (SETQ G168195 (CAR G168227)) + NIL) + (PROGN + (PROGN + (SPADLET |name| (CAR G168195)) + (SPADLET |m| (CDR G168195)) + G168195) + NIL)) + NIL) + (SEQ (EXIT + (PROGN + (COND + ((NULL |$collectOutput|) + (TERPRI + |$algebraOutputStream|))) + (SPADLET |andWhere| + (COND + ((BOOT-EQUAL |name| + |firstName|) + (MAKESTRING "where ")) + ('T (MAKESTRING "and ")))) + (SPADLET |line| + (STRCONC |andWhere| + (PNAME |name|))) + (|maprinChk| + (CONS '= + (CONS |line| (CONS |m| NIL))))))))))))))))) ; -- note that this could place a new element on $MatrixList, hence the loop @@ -3027,26 +3063,31 @@ NIL ; :[['BRACKET,['AGGLST,:rest row]] for row in CDDR m]]] (DEFUN |deMatrix| (|m|) - (PROG NIL - (RETURN - (SEQ - (CONS (QUOTE BRACKET) - (CONS - (CONS (QUOTE AGGLST) - (PROG (#0=G168248) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=G168253 (CDDR |m|) (CDR #1#)) (|row| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |row| (CAR #1#)) NIL)) - (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS - (CONS (QUOTE BRACKET) - (CONS (CONS (QUOTE AGGLST) (CDR |row|)) NIL)) - #0#)))))))) - NIL)))))) + (PROG () + (RETURN + (SEQ (CONS 'BRACKET + (CONS (CONS 'AGGLST + (PROG (G168248) + (SPADLET G168248 NIL) + (RETURN + (DO ((G168253 (CDDR |m|) + (CDR G168253)) + (|row| NIL)) + ((OR (ATOM G168253) + (PROGN + (SETQ |row| (CAR G168253)) + NIL)) + (NREVERSE0 G168248)) + (SEQ + (EXIT + (SETQ G168248 + (CONS + (CONS 'BRACKET + (CONS + (CONS 'AGGLST (CDR |row|)) + NIL)) + G168248)))))))) + NIL)))))) ;LargeMatrixp(u,width, dist) == ; -- sees if there is a matrix wider than 'width' in the next 'dist' @@ -3089,65 +3130,101 @@ NIL ; ans (DEFUN |LargeMatrixp| (|u| |width| |dist|) - (PROG (|op| |n| |ans|) - (RETURN - (SEQ - (COND - ((ATOM |u|) NIL) - ((<= (CDAR |u|) |width|) NIL) - ((QUOTE T) - (SPADLET |op| (CAAR |u|)) - (COND - ((BOOT-EQUAL |op| (QUOTE MATRIX)) (|largeMatrixAlist| |u|)) - ((MEMQ |op| - (QUOTE (LET RARROW SEGMENT - CONCAT CONCATB PAREN BRACKET BRACE))) - (SPADLET |dist| (SPADDIFFERENCE |dist| 3)) - (SPADLET |width| (SPADDIFFERENCE |width| 3)) - (SPADLET |ans| - (DO ((#0=G168272 (CDR |u|) (CDR #0#)) (|v| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |v| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (COND - ((SPADLET |ans| (|LargeMatrixp| |v| |width| |dist|)) - (RETURN (|largeMatrixAlist| |ans|))) - ((QUOTE T) - (SPADLET |dist| (SPADDIFFERENCE |dist| (WIDTH |v|))) - (COND ((MINUSP |dist|) (RETURN NIL))))))))) - |ans|) - ((MEMQ |op| (QUOTE (+ *))) - (COND - ((SPADLET |ans| - (|LargeMatrixp| (CADR |u|) (SPADDIFFERENCE |width| 3) |dist|)) - (|largeMatrixAlist| |ans|)) - ((QUOTE T) - (SPADLET |n| (PLUS 3 (WIDTH (CADR |u|)))) - (SPADLET |dist| (SPADDIFFERENCE |dist| |n|)) - (SPADLET |ans| - (DO ((#1=G168281 (CDDR |u|) (CDR #1#)) (|v| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |v| (CAR #1#)) NIL)) NIL) - (SEQ - (EXIT + (PROG (|op| |n| |ans|) + (RETURN + (SEQ (COND + ((ATOM |u|) NIL) + ((<= (CDAR |u|) |width|) NIL) + ('T (SPADLET |op| (CAAR |u|)) (COND - ((SPADLET |ans| (|LargeMatrixp| |v| |width| |dist|)) - (RETURN (|largeMatrixAlist| |ans|))) - ((QUOTE T) - (SPADLET |dist| (SPADDIFFERENCE |dist| (WIDTH |v|))) - (COND ((MINUSP |dist|) (RETURN NIL))))))))) - |ans|))) - ((QUOTE T) - (SPADLET |ans| - (DO ((#2=G168290 (CDR |u|) (CDR #2#)) (|v| NIL)) - ((OR (ATOM #2#) (PROGN (SETQ |v| (CAR #2#)) NIL)) NIL) - (SEQ - (EXIT - (COND - ((SPADLET |ans| (|LargeMatrixp| |v| |width| |dist|)) - (RETURN (|largeMatrixAlist| |ans|))) - ((QUOTE T) - (SPADLET |dist| (SPADDIFFERENCE |dist| (WIDTH |v|))) - (COND ((MINUSP |dist|) (RETURN NIL))))))))) - |ans|)))))))) + ((BOOT-EQUAL |op| 'MATRIX) (|largeMatrixAlist| |u|)) + ((MEMQ |op| + '(LET RARROW + SEGMENT + - + CONCAT + CONCATB + PAREN + BRACKET + BRACE)) + (SPADLET |dist| (SPADDIFFERENCE |dist| 3)) + (SPADLET |width| (SPADDIFFERENCE |width| 3)) + (SPADLET |ans| + (DO ((G168272 (CDR |u|) (CDR G168272)) + (|v| NIL)) + ((OR (ATOM G168272) + (PROGN + (SETQ |v| (CAR G168272)) + NIL)) + NIL) + (SEQ (EXIT (COND + ((SPADLET |ans| + (|LargeMatrixp| |v| |width| + |dist|)) + (RETURN + (|largeMatrixAlist| |ans|))) + ('T + (SPADLET |dist| + (SPADDIFFERENCE |dist| + (WIDTH |v|))) + (COND + ((MINUSP |dist|) + (RETURN NIL))))))))) + |ans|) + ((MEMQ |op| '(+ *)) + (COND + ((SPADLET |ans| + (|LargeMatrixp| (CADR |u|) + (SPADDIFFERENCE |width| 3) |dist|)) + (|largeMatrixAlist| |ans|)) + ('T (SPADLET |n| (PLUS 3 (WIDTH (CADR |u|)))) + (SPADLET |dist| (SPADDIFFERENCE |dist| |n|)) + (SPADLET |ans| + (DO ((G168281 (CDDR |u|) (CDR G168281)) + (|v| NIL)) + ((OR (ATOM G168281) + (PROGN + (SETQ |v| (CAR G168281)) + NIL)) + NIL) + (SEQ (EXIT + (COND + ((SPADLET |ans| + (|LargeMatrixp| |v| |width| + |dist|)) + (RETURN + (|largeMatrixAlist| |ans|))) + ('T + (SPADLET |dist| + (SPADDIFFERENCE |dist| + (WIDTH |v|))) + (COND + ((MINUSP |dist|) + (RETURN NIL))))))))) + |ans|))) + ('T + (SPADLET |ans| + (DO ((G168290 (CDR |u|) (CDR G168290)) + (|v| NIL)) + ((OR (ATOM G168290) + (PROGN + (SETQ |v| (CAR G168290)) + NIL)) + NIL) + (SEQ (EXIT (COND + ((SPADLET |ans| + (|LargeMatrixp| |v| |width| + |dist|)) + (RETURN + (|largeMatrixAlist| |ans|))) + ('T + (SPADLET |dist| + (SPADDIFFERENCE |dist| + (WIDTH |v|))) + (COND + ((MINUSP |dist|) + (RETURN NIL))))))))) + |ans|)))))))) ; --Relying that falling out of a loop gives nil ;largeMatrixAlist u == @@ -3157,15 +3234,19 @@ NIL ; nil (DEFUN |largeMatrixAlist| (|u|) - (PROG (|op| |r|) - (RETURN - (COND - ((AND (PAIRP |u|) - (PROGN (SPADLET |op| (QCAR |u|)) (SPADLET |r| (QCDR |u|)) (QUOTE T))) - (COND - ((AND (PAIRP |op|) (EQ (QCAR |op|) (QUOTE MATRIX))) (|deMatrix| |u|)) - ((QUOTE T) (OR (|largeMatrixAlist| |op|) (|largeMatrixAlist| |r|))))) - ((QUOTE T) NIL))))) + (PROG (|op| |r|) + (RETURN + (COND + ((AND (PAIRP |u|) + (PROGN + (SPADLET |op| (QCAR |u|)) + (SPADLET |r| (QCDR |u|)) + 'T)) + (COND + ((AND (PAIRP |op|) (EQ (QCAR |op|) 'MATRIX)) + (|deMatrix| |u|)) + ('T (OR (|largeMatrixAlist| |op|) (|largeMatrixAlist| |r|))))) + ('T NIL))))) ;PushMatrix m == ; --Adds the matrix to the look-aside list, and returns a name for it @@ -3178,55 +3259,54 @@ NIL ; name (DEFUN |PushMatrix| (|m|) - (PROG (|name|) - (RETURN - (SEQ - (SPADLET |name| - (DO ((#0=G168328 |$MatrixList| (CDR #0#)) (|v| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |v| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (COND - ((BOOT-EQUAL |m| (CDR |v|)) (EXIT (RETURN (CAR |v|))))))))) - (COND (|name| (EXIT |name|))) - (SPADLET |name| - (INTERNL "matrix" - (STRINGIMAGE (SPADLET |$MatrixCount| (PLUS |$MatrixCount| 1))))) - (SPADLET |$MatrixList| (CONS (CONS |name| |m|) |$MatrixList|)) - (EXIT |name|))))) + (PROG (|name|) + (DECLARE (SPECIAL |$MatrixList| |$MatrixCount|)) + (RETURN + (SEQ (SPADLET |name| + (DO ((G168328 |$MatrixList| (CDR G168328)) + (|v| NIL)) + ((OR (ATOM G168328) + (PROGN (SETQ |v| (CAR G168328)) NIL)) + NIL) + (SEQ (EXIT (COND + ((BOOT-EQUAL |m| (CDR |v|)) + (EXIT (RETURN (CAR |v|))))))))) + (COND (|name| (EXIT |name|))) + (SPADLET |name| + (INTERNL "matrix" + (STRINGIMAGE + (SPADLET |$MatrixCount| + (PLUS |$MatrixCount| 1))))) + (SPADLET |$MatrixList| + (CONS (CONS |name| |m|) |$MatrixList|)) + (EXIT |name|))))) ;quoteApp([.,a],x,y,d) == APP(a,x+1,y,appChar(PNAME "'",x,y,d)) -(DEFUN |quoteApp| (#0=G168341 |x| |y| |d|) - (PROG (|a|) - (RETURN - (PROGN - (SPADLET |a| (CADR #0#)) - (APP |a| (PLUS |x| 1) |y| (|appChar| (PNAME (QUOTE |'|)) |x| |y| |d|)))))) +(DEFUN |quoteApp| (G168341 |x| |y| |d|) + (PROG (|a|) + (RETURN + (PROGN + (SPADLET |a| (CADR G168341)) + (APP |a| (PLUS |x| 1) |y| (|appChar| (PNAME '|'|) |x| |y| |d|)))))) ;quoteSub [.,a] == subspan a -(DEFUN |quoteSub| (#0=G168352) - (PROG (|a|) - (RETURN (PROGN (SPADLET |a| (CADR #0#)) (|subspan| |a|))))) - +(DEFUN |quoteSub| (G168352) + (PROG (|a|) + (RETURN (PROGN (SPADLET |a| (CADR G168352)) (|subspan| |a|))))) + ;quoteSuper [.,a] == superspan a -(DEFUN |quoteSuper| (#0=G168363) - (PROG (|a|) - (RETURN - (PROGN - (SPADLET |a| (CADR #0#)) - (|superspan| |a|))))) +(DEFUN |quoteSuper| (G168363) + (PROG (|a|) + (RETURN (PROGN (SPADLET |a| (CADR G168363)) (|superspan| |a|))))) ;quoteWidth [.,a] == 1 + WIDTH a -(DEFUN |quoteWidth| (#0=G168374) - (PROG (|a|) - (RETURN - (PROGN - (SPADLET |a| (CADR #0#)) - (PLUS 1 (WIDTH |a|)))))) +(DEFUN |quoteWidth| (G168374) + (PROG (|a|) + (RETURN (PROGN (SPADLET |a| (CADR G168374)) (PLUS 1 (WIDTH |a|)))))) ;SubstWhileDesizing(u,m) == ; -- arg. m is always nil (historical: EU directive to increase argument lists 1991/XGII) @@ -3250,24 +3330,21 @@ NIL ; [SubstWhileDesizing(op,m),:l'] (DEFUN |SubstWhileDesizing| (|u| |m|) - (PROG (|op| |n| |l| |l'|) - (RETURN - (COND - ((ATOM |u|) |u|) - ((QUOTE T) - (SPADLET |op| (CAAR |u|)) - (SPADLET |n| (CDAR |u|)) - (SPADLET |l| (CDR |u|)) - (COND - ((BOOT-EQUAL |op| (QUOTE MATRIX)) - (SPADLET |l'| (|SubstWhileDesizingList| (CDR |l|) |m|)) - (SPADLET |u| (CONS |op| (CONS NIL |l'|))) - (|PushMatrix| |u|)) - ((QUOTE T) - (SPADLET |l'| (|SubstWhileDesizingList| |l| |m|)) - (COND - ((ATOM |op|) (CONS |op| |l'|)) - ((QUOTE T) (CONS (|SubstWhileDesizing| |op| |m|) |l'|)))))))))) + (PROG (|op| |n| |l| |l'|) + (RETURN + (COND + ((ATOM |u|) |u|) + ('T (SPADLET |op| (CAAR |u|)) (SPADLET |n| (CDAR |u|)) + (SPADLET |l| (CDR |u|)) + (COND + ((BOOT-EQUAL |op| 'MATRIX) + (SPADLET |l'| (|SubstWhileDesizingList| (CDR |l|) |m|)) + (SPADLET |u| (CONS |op| (CONS NIL |l'|))) + (|PushMatrix| |u|)) + ('T (SPADLET |l'| (|SubstWhileDesizingList| |l| |m|)) + (COND + ((ATOM |op|) (CONS |op| |l'|)) + ('T (CONS (|SubstWhileDesizing| |op| |m|) |l'|)))))))))) ;--;SubstWhileDesizingList(u,m) == ;--; -- m is always nil (historical) @@ -3291,26 +3368,35 @@ NIL ; u (DEFUN |SubstWhileDesizingList| (|u| |m|) - (PROG (|a| |b| |res| |tail|) - (RETURN - (SEQ - (COND - ((AND (PAIRP |u|) (PROGN (SPADLET |a| (QCAR |u|)) (SPADLET |b| (QCDR |u|)) (QUOTE T))) - (SPADLET |res| (COND ((ATOM |a|) (CONS |a| NIL)) ((QUOTE T) (CONS (|SubstWhileDesizing| |a| |m|) NIL)))) - (SPADLET |tail| |res|) - (DO ((#0=G168412 |b| (CDR #0#)) (|i| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |i| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (COND - ((ATOM |i|) (RPLACD |tail| (CONS |i| NIL))) - ((QUOTE T) - (RPLACD |tail| - (CONS (|SubstWhileDesizing| |i| |m|) NIL)))) - (SPADLET |tail| (CDR |tail|)))))) - |res|) - ((QUOTE T) |u|)))))) + (PROG (|a| |b| |res| |tail|) + (RETURN + (SEQ (COND + ((AND (PAIRP |u|) + (PROGN + (SPADLET |a| (QCAR |u|)) + (SPADLET |b| (QCDR |u|)) + 'T)) + (SPADLET |res| + (COND + ((ATOM |a|) (CONS |a| NIL)) + ('T (CONS (|SubstWhileDesizing| |a| |m|) NIL)))) + (SPADLET |tail| |res|) + (DO ((G168412 |b| (CDR G168412)) (|i| NIL)) + ((OR (ATOM G168412) + (PROGN (SETQ |i| (CAR G168412)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (COND + ((ATOM |i|) + (RPLACD |tail| (CONS |i| NIL))) + ('T + (RPLACD |tail| + (CONS + (|SubstWhileDesizing| |i| |m|) + NIL)))) + (SPADLET |tail| (CDR |tail|)))))) + |res|) + ('T |u|)))))) ;--% Printing of Sigmas , Pis and Intsigns ;sigmaSub u == @@ -3318,50 +3404,49 @@ NIL ; MAX(1 + height CADR u, subspan CADDR u) (DEFUN |sigmaSub| (|u|) - (MAX (PLUS 1 (|height| (CADR |u|))) (|subspan| (CADDR |u|)))) + (MAX (PLUS 1 (|height| (CADR |u|))) (|subspan| (CADDR |u|)))) ;sigmaSup u == ; --The height function for sigmas with lower limit only ; MAX(1, superspan CADDR u) -(DEFUN |sigmaSup| (|u|) (MAX 1 (|superspan| (CADDR |u|)))) +(DEFUN |sigmaSup| (|u|) (MAX 1 (|superspan| (CADDR |u|)))) ;sigmaApp(u,x,y,d) == ; u is [.,bot,arg] or THROW('outputFailure,'outputFailure) ; bigopAppAux(bot,nil,arg,x,y,d,'sigma) (DEFUN |sigmaApp| (|u| |x| |y| |d|) - (PROG (|ISTMP#1| |bot| |ISTMP#2| |arg|) - (RETURN - (PROGN - (OR - (AND (PAIRP |u|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |u|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |bot| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |arg| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (THROW (QUOTE |outputFailure|) (QUOTE |outputFailure|))) - (|bigopAppAux| |bot| NIL |arg| |x| |y| |d| (QUOTE |sigma|)))))) + (PROG (|ISTMP#1| |bot| |ISTMP#2| |arg|) + (RETURN + (PROGN + (OR (AND (PAIRP |u|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |bot| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |arg| (QCAR |ISTMP#2|)) + 'T)))))) + (THROW '|outputFailure| '|outputFailure|)) + (|bigopAppAux| |bot| NIL |arg| |x| |y| |d| '|sigma|))))) ;sigma2App(u,x,y,d) == ; [.,bot,top,arg]:=u ; bigopAppAux(bot,top,arg,x,y,d,'sigma) (DEFUN |sigma2App| (|u| |x| |y| |d|) - (PROG (|bot| |top| |arg|) - (RETURN - (PROGN - (SPADLET |bot| (CADR |u|)) - (SPADLET |top| (CADDR |u|)) - (SPADLET |arg| (CADDDR |u|)) - (|bigopAppAux| |bot| |top| |arg| |x| |y| |d| (QUOTE |sigma|)))))) + (PROG (|bot| |top| |arg|) + (RETURN + (PROGN + (SPADLET |bot| (CADR |u|)) + (SPADLET |top| (CADDR |u|)) + (SPADLET |arg| (CADDDR |u|)) + (|bigopAppAux| |bot| |top| |arg| |x| |y| |d| '|sigma|))))) ;bigopWidth(bot,top,arg,kind) == ; kindWidth := (kind = 'pi => 5; 3) @@ -3675,7 +3760,7 @@ NIL ;overbarWidth u == WIDTH u.1 -(DEFUN |overbarWidth| (|u|) (WIDTH (ELT |u| 1))) +(DEFUN |overbarWidth| (|u|) (WIDTH (ELT |u| 1))) ;overbarApp(u,x,y,d) == ; underApp:= APP(u.1,x,y,d) @@ -3862,6 +3947,7 @@ NIL ; first x (DEFUN |concatTrouble,fixUp| (|x|) + (DECLARE (SPECIAL |$addBlankIfTrue|)) (SEQ (IF (CDR |x|) (EXIT (SEQ (IF |$addBlankIfTrue| (EXIT (CONS 'CONCATB |x|))) (EXIT (CONS 'CONCAT |x|))))) @@ -3924,6 +4010,7 @@ NIL (DEFUN |splitConcat| (LIST |maxWidth| |firstTimeIfTrue|) (PROG (|oneOrZero| |maxW| |width| |l| |totalWidth| |x|) + (DECLARE (SPECIAL |$addBlankIfTrue|)) (RETURN (SEQ (COND ((NULL LIST) NIL) @@ -3968,6 +4055,8 @@ NIL ; if ^$collectOutput then TERPRI $algebraOutputStream (DEFUN |spadPrint| (|x| |m|) + (DECLARE (SPECIAL |$algebraOutputStream| |$collectOutput| + |$NoValueMode|)) (COND ((BOOT-EQUAL |m| |$NoValueMode|) |x|) ('T @@ -3989,6 +4078,8 @@ NIL (DEFUN |formulaFormat| (|expr|) (PROG (|sff| |formatFn| |displayFn|) + (DECLARE (SPECIAL |$formulaOutputStream| |$algebraOutputStream| + |$collectOutput| |$OutputForm|)) (RETURN (PROGN (SPADLET |sff| '(|ScriptFormulaFormat|)) @@ -4016,6 +4107,8 @@ NIL (DEFUN |texFormat| (|expr|) (PROG (|tf| |formatFn| |displayFn|) + (DECLARE (SPECIAL |$texOutputStream| |$IOindex| |$Integer| + |$OutputForm|)) (RETURN (PROGN (SPADLET |tf| '(|TexFormat|)) @@ -4041,6 +4134,7 @@ NIL (DEFUN |texFormat1| (|expr|) (PROG (|tf| |formatFn| |displayFn|) + (DECLARE (SPECIAL |$texOutputStream| |$OutputForm|)) (RETURN (PROGN (SPADLET |tf| '(|TexFormat|)) @@ -4067,6 +4161,7 @@ NIL (DEFUN |mathmlFormat| (|expr|) (PROG (|mml| |mmlrep| |formatFn| |displayFn|) + (DECLARE (SPECIAL |$mathmlOutputStream| |$OutputForm|)) (RETURN (PROGN (SPADLET |mml| '(|MathMLFormat|)) @@ -4118,6 +4213,9 @@ NIL (DEFUN |output| (|expr| |domain|) (PROG (T$ |x| |printfun| |textwrit| |ISTMP#1| S) + (DECLARE (SPECIAL |$mathmlFormat| |$texFormat| |$algebraFormat| + |$fortranOutputStream| |$collectOutput| + |$fortranFormat| |$formulaFormat| |$OutputForm|)) (RETURN (PROGN (COND @@ -4208,6 +4306,7 @@ NIL (DEFUN |outputNumber| (|start| |linelength| |num|) (PROG (|under| |blnks| |firsttime|) + (DECLARE (SPECIAL |$outputLines| |$collectOutput|)) (RETURN (SEQ (PROGN (COND @@ -4274,6 +4373,7 @@ NIL (DEFUN |outputString| (|start| |linelength| |str|) (PROG (|blnks|) + (DECLARE (SPECIAL |$outputLines| |$collectOutput|)) (RETURN (SEQ (PROGN (COND @@ -4357,6 +4457,7 @@ NIL (DEFUN |getOutputAbbreviatedForm| (|form|) (PROG (|op| |u| |ml| |x'| |argl|) + (DECLARE (SPECIAL |$OutputForm|)) (RETURN (SEQ (COND ((AND (PAIRP |form|) @@ -4378,8 +4479,7 @@ NIL (PROG (G168949) (SPADLET G168949 NIL) (RETURN - (DO ((G168955 |argl| - (CDR G168955)) + (DO ((G168955 |argl| (CDR G168955)) (|x| NIL) (G168956 |ml| (CDR G168956)) (|m| NIL)) @@ -4443,17 +4543,13 @@ NIL (PROG (G168985) (SPADLET G168985 NIL) (RETURN - (DO ((G168990 |args| (CDR G168990)) - (|y| NIL)) + (DO ((G168990 |args| (CDR G168990)) (|y| NIL)) ((OR (ATOM G168990) - (PROGN - (SETQ |y| (CAR G168990)) - NIL)) + (PROGN (SETQ |y| (CAR G168990)) NIL)) (NREVERSE0 G168985)) (SEQ (EXIT (SETQ G168985 (CONS (|outputOp| |y|) G168985))))))))) ('T |x|)))))) - ;--% MAP PRINTER (FROM EV BOOT) ;printMap u == ; printBasic specialChar 'lbrk @@ -4466,6 +4562,7 @@ NIL (DEFUN |printMap| (|u|) (PROG (|initialFlag| |x| |l| |ISTMP#1| |n|) + (DECLARE (SPECIAL |$algebraOutputStream| |$collectOutput|)) (RETURN (SEQ (PROGN (|printBasic| (|specialChar| '|lbrk|)) @@ -4545,8 +4642,7 @@ NIL (SPADLET |ISTMP#2| (QCDR |x|)) (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) - NIL)))))))))))))))) + (EQ (QCDR |ISTMP#2|) NIL)))))))))))))))) ;printMap1(x,initialFlag) == ; initialFlag => printBasic CADR x @@ -4571,6 +4667,7 @@ NIL ; PRIN0(x,$algebraOutputStream) (DEFUN |printBasic| (|x|) + (DECLARE (SPECIAL |$algebraOutputStream|)) (COND ((BOOT-EQUAL |x| '(|One|)) (PRIN1 1 |$algebraOutputStream|)) ((BOOT-EQUAL |x| '(|Zero|)) (PRIN1 0 |$algebraOutputStream|)) @@ -4619,6 +4716,7 @@ NIL (DEFUN |charyTop| (|u| |start| |linelength|) (PROG (|ISTMP#2| |ISTMP#3| |ISTMP#4| |ISTMP#5| |l| |ISTMP#1| |a| |b| |w| |v| |d| |m| |n|) + (DECLARE (SPECIAL |$testOutputLineList| |$testOutputLineFlag|)) (RETURN (SEQ (COND ((OR (AND (PAIRP |u|) (EQ (QCAR |u|) 'SC) @@ -4948,10 +5046,10 @@ NIL ; nil (DEFUN |charySemiColon| (|u| |v| |start| |linelength|) + (declare (ignore |v|)) (SEQ (PROGN (DO ((G169335 (CDR |u|) (CDR G169335)) (|a| NIL)) - ((OR (ATOM G169335) - (PROGN (SETQ |a| (CAR G169335)) NIL)) + ((OR (ATOM G169335) (PROGN (SETQ |a| (CAR G169335)) NIL)) NIL) (SEQ (EXIT (|charyTop| |a| |start| |linelength|)))) NIL))) @@ -4962,6 +5060,7 @@ NIL ; '" " (DEFUN |charyMinus| (|u| |v| |start| |linelength|) + (declare (ignore |u|)) (PROGN (|charybdis| (MAKESTRING "-") |start| |linelength|) (|charybdis| (ELT |v| 1) (PLUS |start| 3) @@ -4979,6 +5078,7 @@ NIL ; '" " (DEFUN |charyBinary| (|d| |u| |v| |start| |linelength|) + (declare (ignore |u|)) (COND ((|member| |d| '(" := " "= ")) (|charybdis| (CONS 'CONCATB (CONS (ELT |v| 1) (CONS |d| NIL))) @@ -5000,6 +5100,7 @@ NIL ; '" " (DEFUN |charyEquatnum| (|u| |v| |start| |linelength|) + (declare (ignore |v|)) (PROGN (|charybdis| (CONS 'PAREN (CONS (ELT |u| 1) NIL)) |start| |linelength|) @@ -5119,6 +5220,8 @@ NIL (DEFUN |scylla| (|n| |v|) (PROG (|y|) + (DECLARE (SPECIAL |$algebraOutputStream| |$outputLines| + |$collectOutput|)) (RETURN (PROGN (SPADLET |y| (LASSOC |n| |v|)) @@ -5257,7 +5360,7 @@ NIL ;appargs(u,x,y,d) == appargs1(u,x,y,d,'";") (DEFUN |appargs| (|u| |x| |y| |d|) - (|appargs1| |u| |x| |y| |d| (MAKESTRING ";"))) + (|appargs1| |u| |x| |y| |d| (MAKESTRING ";"))) ;--Note that the definition of appargs1 below is identical to that of ;--appagg1 above except that the former calls appargs and the latter @@ -5509,13 +5612,13 @@ NIL ; appparu(CADR u, x, y, d) (DEFUN |appparu1| (|u| |x| |y| |d|) - (|appparu| (CADR |u|) |x| |y| |d|)) + (|appparu| (CADR |u|) |x| |y| |d|)) ;appsc(u, x, y, d) == ; appagg1(rest u, x, y, d, '";") (DEFUN |appsc| (|u| |x| |y| |d|) - (|appagg1| (CDR |u|) |x| |y| |d| (MAKESTRING ";"))) + (|appagg1| (CDR |u|) |x| |y| |d| (MAKESTRING ";"))) ;appsetq(u, x, y, d) == ; w := WIDTH first u @@ -5585,13 +5688,15 @@ NIL ;eq0(u) == 0 -(DEFUN |eq0| (|u|) 0) +(DEFUN |eq0| (|u|) + (declare (ignore |u|)) + 0) ;height(u) == ; superspan(u) + 1 + subspan(u) (DEFUN |height| (|u|) - (PLUS (PLUS (|superspan| |u|) 1) (|subspan| |u|))) + (PLUS (PLUS (|superspan| |u|) 1) (|subspan| |u|))) ;extsub(u) == ; MAX(subspan agg(5, u), height(agg(3, u)), subspan CADR u ) @@ -5770,6 +5875,7 @@ NIL (DEFUN |longext| (|u| |i| |n|) (PROG (|x| |y|) + (DECLARE (SPECIAL |$algebraOutputStream| |$collectOutput|)) (RETURN (PROGN (SPADLET |x| (REVERSE |u|)) @@ -5831,7 +5937,48 @@ NIL ; d := APP(specialChar('urc), x + widR + widB + 1, y + supB+1, d) ; d := APP(specialChar('bslash), x + widR - 1, y - subB, d) -(DEFUN |rootApp| (|u| |x| |y| |d|) +(pprint '(DEFUN |rootApp| (|u| |x| |y| |d|) + (PROG (|widB| |supB| |subB| |subR| |widR|) + (RETURN + (PROGN + (SPADLET |widB| (WIDTH (ELT |u| 1))) + (SPADLET |supB| (|superspan| (ELT |u| 1))) + (SPADLET |subB| (|subspan| (ELT |u| 1))) + (COND + ((> (|#| |u|) 2) (SPADLET |widR| (WIDTH (ELT |u| 2))) + (SPADLET |subR| (|subspan| (ELT |u| 2))) + (SPADLET |d| + (APP (ELT |u| 2) |x| + (PLUS (PLUS (SPADDIFFERENCE |y| |subB|) 1) + |subR|) + |d|))) + ('T (SPADLET |widR| 1))) + (SPADLET |d| + (APP (ELT |u| 1) (PLUS (PLUS |x| |widR|) 1) |y| |d|)) + (SPADLET |d| + (|apphor| (PLUS (PLUS |x| |widR|) 1) + (PLUS (PLUS |x| |widR|) |widB|) + (PLUS (PLUS |y| |supB|) 1) |d| + (|specialChar| '|hbar|))) + (SPADLET |d| + (|appvertline| (|specialChar| '|vbar|) + (PLUS |x| |widR|) (SPADDIFFERENCE |y| |subB|) + (PLUS |y| |supB|) |d|)) + (SPADLET |d| + (APP (|specialChar| '|ulc|) (PLUS |x| |widR|) + (PLUS (PLUS |y| |supB|) 1) |d|)) + (SPADLET |d| + (APP (|specialChar| '|urc|) + (PLUS (PLUS (PLUS |x| |widR|) |widB|) 1) + (PLUS (PLUS |y| |supB|) 1) |d|)) + (SPADLET |d| + (APP (|specialChar| '|bslash|) + (SPADDIFFERENCE (PLUS |x| |widR|) 1) + (SPADDIFFERENCE |y| |subB|) |d|)))))) + +) + + (DEFUN |rootApp| (|u| |x| |y| |d|) (PROG (|widB| |supB| |subB| |subR| |widR|) (RETURN (PROGN @@ -6026,22 +6173,30 @@ NIL ;nothingWidth x == ; 0 -(DEFUN |nothingWidth| (|x|) 0) +(DEFUN |nothingWidth| (|x|) + (declare (ignore |x|)) + 0) ;nothingSuper x == ; 0 -(DEFUN |nothingSuper| (|x|) 0) +(DEFUN |nothingSuper| (|x|) + (declare (ignore |x|)) + 0) ;nothingSub x == ; 0 -(DEFUN |nothingSub| (|x|) 0) +(DEFUN |nothingSub| (|x|) + (declare (ignore |x|)) + 0) ;nothingApp(u, x, y, d) == ; d -(DEFUN |nothingApp| (|u| |x| |y| |d|) |d|) +(DEFUN |nothingApp| (|u| |x| |y| |d|) + (declare (ignore |u| |x| |y|)) + |d|) ;zagApp(u, x, y, d) == ; w := WIDTH u @@ -6274,8 +6429,7 @@ NIL (PLUS (PLUS |xc| 2) (CAR |w|))) (SPADLET |row| (CDR |row|)) - (SPADLET |w| - (CDR |w|)))))))))))))))))) + (SPADLET |w| (CDR |w|)))))))))))))))))) ;matSuper(x) == ; (x := x.1) => -1 + QUOTIENT(first x.1 + first x.2, 2) @@ -6343,9 +6497,9 @@ NIL ; true => matWList(rest x, matWList1(CDAR x, y) ) (DEFUN |matWList| (|x| |y|) - (COND - ((NULL |x|) |y|) - ((QUOTE T) (|matWList| (CDR |x|) (|matWList1| (CDAR |x|) |y|))))) + (COND + ((NULL |x|) |y|) + ('T (|matWList| (CDR |x|) (|matWList1| (CDAR |x|) |y|))))) ;matWList1(x, y) == ; null x => nil @@ -6426,9 +6580,9 @@ NIL ; u := nextu ; null u => return(nil) -(DEFUN |bracketagglist| - (|u| |start| |linelength| |tchr| |open| |close|) +(DEFUN |bracketagglist| (|u| |start| |linelength| |tchr| |open| |close|) (PROG (|lastx| |s| |nextu| |x| |ichr|) + (declare (special |$algebraOutputStream| |$collectOutput|)) (RETURN (SEQ (PROGN (SPADLET |u| @@ -6513,6 +6667,8 @@ NIL (DEFUN |prnd| (|start| |op|) (PROG (|string|) + (declare (special |$algebraOutputStream| |$outputLines| |$collectOutput| + |$testOutputLineList| |$testOutputLineFlag|)) (RETURN (COND (|$testOutputLineFlag| @@ -6560,7 +6716,7 @@ NIL ((ATOM |x|) |x|) ('T (CONS (COND ((ATOM (CAR |x|)) (CAR |x|)) ('T (CAAR |x|))) - (MMAPCAR |remWidth| (CDR |x|)))))) + (MMAPCAR #'|remWidth| (CDR |x|)))))) ;subSub(u) == ; height CDDR u @@ -7239,6 +7395,7 @@ NIL ; PSTRING u; nil) (DEFUN |mathPrint| (|u|) + (declare (special |$algebraOutputStream| |$collectOutput|)) (PROGN (COND ((NULL |$collectOutput|) (TERPRI |$algebraOutputStream|))) (COND @@ -7267,6 +7424,7 @@ NIL ; if fg and ^$collectOutput then TERPRI $algebraOutputStream (DEFUN |mathPrint1| (|x| |fg|) + (declare (special |$algebraOutputStream| |$collectOutput|)) (PROGN (COND ((AND |fg| (NULL |$collectOutput|)) @@ -7297,6 +7455,9 @@ NIL (DEFUN |maPrin| (|u|) (PROG (|c| |ISTMP#1| |ISTMP#2| |num| |ISTMP#3| |form|) + (declare (special |$algebraOutputStream| |$collectOutput| $LINELENGTH + $MARGIN |$highlightDelta| |$mkTestOutputStack| + |$mkTestFlag| |$runTestFlag|)) (RETURN (COND ((NULL |u|) NIL)