diff --git a/changelog b/changelog index f3b1038..f2ae7de 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +20091008 tpd src/axiom-website/patches.html 20091008.01.tpd.patch +20091008 tpd src/interp/format.lisp cleanup 20091007 tpd src/axiom-website/patches.html 20091007.06.tpd.patch 20091007 tpd src/interp/g-boot.lisp cleanup 20091007 tpd src/axiom-website/patches.html 20091007.05.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index a54b5be..5a4e3bc 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2133,5 +2133,7 @@ src/interp/g-error.lisp cleanup
src/interp/g-cndata.lisp cleanup
20091007.06.tpd.patch src/interp/g-boot.lisp cleanup
+20091008.01.tpd.patch +src/interp/format.lisp cleanup
diff --git a/src/interp/format.lisp.pamphlet b/src/interp/format.lisp.pamphlet index 9cba58f..99f778f 100644 --- a/src/interp/format.lisp.pamphlet +++ b/src/interp/format.lisp.pamphlet @@ -24,7 +24,8 @@ ; sayMSG formatModemap old2NewModemaps displayTranModemap m (DEFUN |sayModemap| (|m|) - (|sayMSG| (|formatModemap| (|old2NewModemaps| (|displayTranModemap| |m|))))) + (|sayMSG| + (|formatModemap| (|old2NewModemaps| (|displayTranModemap| |m|))))) ;sayModemapWithNumber(m,n) == ; msg := reverse cleanUpSegmentedMsg reverse ["%i","%i",'" ", @@ -33,25 +34,25 @@ ; sayMSG flowSegmentedMsg(reverse msg,$LINELENGTH,3) (DEFUN |sayModemapWithNumber| (|m| |n|) - (PROG (|msg|) - (RETURN - (PROGN - (SPADLET |msg| - (REVERSE - (|cleanUpSegmentedMsg| - (REVERSE - (CONS - (QUOTE |%i|) - (CONS - (QUOTE |%i|) - (CONS - " " - (CONS - (STRCONC (|lbrkSch|) (|object2String| |n|) (|rbrkSch|)) - (APPEND - (|formatModemap| (|displayTranModemap| |m|)) - (CONS (QUOTE |%u|) (CONS (QUOTE |%u|) NIL))))))))))) - (|sayMSG| (|flowSegmentedMsg| (REVERSE |msg|) $LINELENGTH 3)))))) + (PROG (|msg|) + (DECLARE (SPECIAL $LINELENGTH)) + (RETURN + (PROGN + (SPADLET |msg| + (REVERSE (|cleanUpSegmentedMsg| + (REVERSE (CONS '|%i| + (CONS '|%i| + (CONS " " + (CONS + (STRCONC (|lbrkSch|) + (|object2String| |n|) + (|rbrkSch|)) + (APPEND + (|formatModemap| + (|displayTranModemap| |m|)) + (CONS '|%u| + (CONS '|%u| NIL))))))))))) + (|sayMSG| (|flowSegmentedMsg| (REVERSE |msg|) $LINELENGTH 3)))))) ;displayOpModemaps(op,modemaps) == ; TERPRI() @@ -61,35 +62,31 @@ ; for modemap in modemaps repeat sayModemap modemap (DEFUN |displayOpModemaps| (|op| |modemaps|) - (PROG (|count| |phrase|) - (RETURN - (SEQ - (PROGN - (TERPRI) - (SPADLET |count| (|#| |modemaps|)) - (SPADLET |phrase| - (COND - ((EQL |count| 1) (QUOTE |modemap|)) - ((QUOTE T) (QUOTE |modemaps|)))) - (|sayMSG| - (CONS - (QUOTE |%b|) - (CONS - |count| - (CONS - (QUOTE |%d|) - (CONS - |phrase| - (CONS - " for" - (CONS - (QUOTE |%b|) - (CONS - |op| - (CONS (QUOTE |%d|) (CONS (MAKESTRING ":") NIL)))))))))) - (DO ((#0=#:G166070 |modemaps| (CDR #0#)) (|modemap| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |modemap| (CAR #0#)) NIL)) NIL) - (SEQ (EXIT (|sayModemap| |modemap|))))))))) + (PROG (|count| |phrase|) + (RETURN + (SEQ (PROGN + (TERPRI) + (SPADLET |count| (|#| |modemaps|)) + (SPADLET |phrase| + (COND + ((EQL |count| 1) '|modemap|) + ('T '|modemaps|))) + (|sayMSG| + (CONS '|%b| + (CONS |count| + (CONS '|%d| + (CONS |phrase| + (CONS " for" + (CONS '|%b| + (CONS |op| + (CONS '|%d| + (CONS (MAKESTRING ":") NIL)))))))))) + (DO ((G166070 |modemaps| (CDR G166070)) + (|modemap| NIL)) + ((OR (ATOM G166070) + (PROGN (SETQ |modemap| (CAR G166070)) NIL)) + NIL) + (SEQ (EXIT (|sayModemap| |modemap|))))))))) ;displayTranModemap (mm is [[x,:sig],[pred,:y],:z]) == ; -- The next 8 lines are a HACK to deal with the "partial" definition @@ -108,43 +105,45 @@ ; MSORT listOfPatternIds [sig,[pred,:y]],mm') (DEFUN |displayTranModemap| (|mm|) - (PROG (|x| |pred| |y| |z| |pred'| |b| |c| |sig| |mm'|) - (RETURN - (PROGN - (SPADLET |x| (CAAR |mm|)) - (SPADLET |sig| (CDAR |mm|)) - (SPADLET |pred| (CAADR |mm|)) - (SPADLET |y| (CDADR |mm|)) - (SPADLET |z| (CDDR |mm|)) - (COND - ((AND (PAIRP |pred|) - (EQ (QCAR |pred|) (QUOTE |partial|)) - (PROGN (SPADLET |pred'| (QCDR |pred|)) (QUOTE T))) - (SPADLET |b| (CAR |sig|)) - (SPADLET |c| (CDR |sig|)) - (SPADLET |sig| - (CONS - (CONS (QUOTE |Union|) (CONS |b| (CONS (MAKESTRING "failed") NIL))) - |c|)) - (SPADLET |mm| (CONS (CONS |x| |sig|) (CONS (CONS |pred'| |y|) |z|)))) - ((BOOT-EQUAL |pred| (QUOTE |partial|)) - (SPADLET |b| (CAR |sig|)) - (SPADLET |c| (CDR |sig|)) - (SPADLET |sig| - (CONS - (CONS (QUOTE |Union|) (CONS |b| (CONS (MAKESTRING "failed") NIL))) - |c|)) - (SPADLET |mm| (CONS (CONS |x| |sig|) (CONS |y| |z|)))) - ((QUOTE T) NIL)) - (SPADLET |mm'| - (EQSUBSTLIST - (QUOTE (|m| |n| |p| |q| |r| |s| |t| |i| |j| |k| |l|)) - (MSORT (|listOfPredOfTypePatternIds| |pred|)) - |mm|)) - (EQSUBSTLIST - (QUOTE (D D1 D2 D3 D4 D5 D6 D7 D8 D9 D10 D11 D12 D13 D14)) - (MSORT (|listOfPatternIds| (CONS |sig| (CONS (CONS |pred| |y|) NIL)))) - |mm'|))))) + (PROG (|x| |pred| |y| |z| |pred'| |b| |c| |sig| |mm'|) + (RETURN + (PROGN + (SPADLET |x| (CAAR |mm|)) + (SPADLET |sig| (CDAR |mm|)) + (SPADLET |pred| (CAADR |mm|)) + (SPADLET |y| (CDADR |mm|)) + (SPADLET |z| (CDDR |mm|)) + (COND + ((AND (PAIRP |pred|) (EQ (QCAR |pred|) '|partial|) + (PROGN (SPADLET |pred'| (QCDR |pred|)) 'T)) + (SPADLET |b| (CAR |sig|)) (SPADLET |c| (CDR |sig|)) + (SPADLET |sig| + (CONS (CONS '|Union| + (CONS |b| + (CONS (MAKESTRING "failed") NIL))) + |c|)) + (SPADLET |mm| + (CONS (CONS |x| |sig|) + (CONS (CONS |pred'| |y|) |z|)))) + ((BOOT-EQUAL |pred| '|partial|) (SPADLET |b| (CAR |sig|)) + (SPADLET |c| (CDR |sig|)) + (SPADLET |sig| + (CONS (CONS '|Union| + (CONS |b| + (CONS (MAKESTRING "failed") NIL))) + |c|)) + (SPADLET |mm| (CONS (CONS |x| |sig|) (CONS |y| |z|)))) + ('T NIL)) + (SPADLET |mm'| + (EQSUBSTLIST + '(|m| |n| |p| |q| |r| |s| |t| |i| |j| |k| |l|) + (MSORT (|listOfPredOfTypePatternIds| |pred|)) + |mm|)) + (EQSUBSTLIST + '(D D1 D2 D3 D4 D5 D6 D7 D8 D9 D10 D11 D12 D13 D14) + (MSORT (|listOfPatternIds| + (CONS |sig| (CONS (CONS |pred| |y|) NIL)))) + |mm'|))))) ;listOfPredOfTypePatternIds p == ; p is ['AND,:lp] or p is ['OR,:lp] => @@ -155,41 +154,41 @@ ; nil (DEFUN |listOfPredOfTypePatternIds| (|p|) - (PROG (|lp| |op| |ISTMP#1| |a| |ISTMP#2|) - (RETURN - (SEQ - (COND - ((OR - (AND (PAIRP |p|) - (EQ (QCAR |p|) (QUOTE AND)) - (PROGN (SPADLET |lp| (QCDR |p|)) (QUOTE T))) - (AND (PAIRP |p|) - (EQ (QCAR |p|) (QUOTE OR)) - (PROGN (SPADLET |lp| (QCDR |p|)) (QUOTE T)))) - (UNIONQ - (PROG (#0=#:G166148) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166153 |lp| (CDR #1#)) (|p1| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |p1| (CAR #1#)) NIL)) #0#) - (SEQ - (EXIT - (SETQ #0# (APPEND #0# (|listOfPredOfTypePatternIds| |p1|)))))))) - NIL)) - ((AND (PAIRP |p|) - (PROGN - (SPADLET |op| (QCAR |p|)) - (SPADLET |ISTMP#1| (QCDR |p|)) - (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))))) - (BOOT-EQUAL |op| (QUOTE |ofType|))) - (COND - ((|isPatternVar| |a|) (CONS |a| NIL)) - ((QUOTE T) NIL))) - ((QUOTE T) NIL)))))) + (PROG (|lp| |op| |ISTMP#1| |a| |ISTMP#2|) + (RETURN + (SEQ (COND + ((OR (AND (PAIRP |p|) (EQ (QCAR |p|) 'AND) + (PROGN (SPADLET |lp| (QCDR |p|)) 'T)) + (AND (PAIRP |p|) (EQ (QCAR |p|) 'OR) + (PROGN (SPADLET |lp| (QCDR |p|)) 'T))) + (UNIONQ (PROG (G166148) + (SPADLET G166148 NIL) + (RETURN + (DO ((G166153 |lp| (CDR G166153)) + (|p1| NIL)) + ((OR (ATOM G166153) + (PROGN + (SETQ |p1| (CAR G166153)) + NIL)) + G166148) + (SEQ (EXIT (SETQ G166148 + (APPEND G166148 + (|listOfPredOfTypePatternIds| + |p1|)))))))) + NIL)) + ((AND (PAIRP |p|) + (PROGN + (SPADLET |op| (QCAR |p|)) + (SPADLET |ISTMP#1| (QCDR |p|)) + (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))))) + (BOOT-EQUAL |op| '|ofType|)) + (COND ((|isPatternVar| |a|) (CONS |a| NIL)) ('T NIL))) + ('T NIL)))))) ;removeIsDomains pred == ; pred is ['isDomain,a,b] => true @@ -198,38 +197,42 @@ ; pred (DEFUN |removeIsDomains| (|pred|) - (PROG (|ISTMP#1| |a| |ISTMP#2| |b| |predl|) - (RETURN - (SEQ - (COND - ((AND (PAIRP |pred|) - (EQ (QCAR |pred|) (QUOTE |isDomain|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |pred|)) - (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))))))) - (QUOTE T)) - ((AND (PAIRP |pred|) - (EQ (QCAR |pred|) (QUOTE AND)) - (PROGN (SPADLET |predl| (QCDR |pred|)) (QUOTE T))) - (MKPF - (PROG (#0=#:G166191) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166197 |predl| (CDR #1#)) (|x| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) - (SEQ - (EXIT - (COND - ((NULL (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |isDomain|)))) - (SETQ #0# (CONS |x| #0#))))))))) - (QUOTE AND))) - ((QUOTE T) |pred|)))))) + (PROG (|ISTMP#1| |a| |ISTMP#2| |b| |predl|) + (RETURN + (SEQ (COND + ((AND (PAIRP |pred|) (EQ (QCAR |pred|) '|isDomain|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |pred|)) + (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)))))) + 'T) + ((AND (PAIRP |pred|) (EQ (QCAR |pred|) 'AND) + (PROGN (SPADLET |predl| (QCDR |pred|)) 'T)) + (MKPF (PROG (G166191) + (SPADLET G166191 NIL) + (RETURN + (DO ((G166197 |predl| (CDR G166197)) + (|x| NIL)) + ((OR (ATOM G166197) + (PROGN + (SETQ |x| (CAR G166197)) + NIL)) + (NREVERSE0 G166191)) + (SEQ (EXIT (COND + ((NULL + (AND (PAIRP |x|) + (EQ (QCAR |x|) '|isDomain|))) + (SETQ G166191 + (CONS |x| G166191))))))))) + 'AND)) + ('T |pred|)))))) ;canRemoveIsDomain? pred == ; -- returns nil OR an alist for substitutions of domains ordered so that @@ -241,40 +244,65 @@ ; findSubstitutionOrder? alist (DEFUN |canRemoveIsDomain?| (|pred|) - (PROG (|predl| |ISTMP#1| |a| |ISTMP#2| |b| |alist|) - (RETURN - (SEQ - (PROGN - (SPADLET |alist| - (COND - ((AND (PAIRP |pred|) (EQ (QCAR |pred|) (QUOTE |isDomain|)) (PROGN (SPADLET |ISTMP#1| (QCDR |pred|)) (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))))))) - (CONS (CONS |a| |b|) |alist|)) - ((AND (PAIRP |pred|) (EQ (QCAR |pred|) (QUOTE AND)) (PROGN (SPADLET |predl| (QCDR |pred|)) (QUOTE T))) - (PROG (#0=#:G166251) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166257 |predl| (CDR #1#)) (|pred| NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ |pred| (CAR #1#)) NIL)) - (NREVERSE0 #0#)) - (SEQ - (EXIT - (COND - ((AND (PAIRP |pred|) - (EQ (QCAR |pred|) (QUOTE |isDomain|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |pred|)) - (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))))))) - (SETQ #0# (CONS (CONS |a| |b|) #0#)))))))))))) - (|findSubstitutionOrder?| |alist|)))))) + (PROG (|predl| |ISTMP#1| |a| |ISTMP#2| |b| |alist|) + (RETURN + (SEQ (PROGN + (SPADLET |alist| + (COND + ((AND (PAIRP |pred|) + (EQ (QCAR |pred|) '|isDomain|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |pred|)) + (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)))))) + (CONS (CONS |a| |b|) |alist|)) + ((AND (PAIRP |pred|) (EQ (QCAR |pred|) 'AND) + (PROGN + (SPADLET |predl| (QCDR |pred|)) + 'T)) + (PROG (G166251) + (SPADLET G166251 NIL) + (RETURN + (DO ((G166257 |predl| (CDR G166257)) + (|pred| NIL)) + ((OR (ATOM G166257) + (PROGN + (SETQ |pred| (CAR G166257)) + NIL)) + (NREVERSE0 G166251)) + (SEQ (EXIT + (COND + ((AND (PAIRP |pred|) + (EQ (QCAR |pred|) '|isDomain|) + (PROGN + (SPADLET |ISTMP#1| + (QCDR |pred|)) + (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)))))) + (SETQ G166251 + (CONS (CONS |a| |b|) + G166251)))))))))))) + (|findSubstitutionOrder?| |alist|)))))) ;findSubstitutionOrder? alist == fn(alist,nil) where ; -- returns NIL or an appropriate substituion order @@ -285,58 +313,62 @@ ; nil (DEFUN |findSubstitutionOrder?,fn| (|alist| |res|) - (PROG (|a| |b| |choice|) - (RETURN - (SEQ - (IF (NULL |alist|) (EXIT (NREVERSE |res|))) - (IF - (SPADLET |choice| - (PROG (#0=#:G166281) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166289 NIL #0#) (#2=#:G166290 |alist| (CDR #2#)) (|x| NIL)) - ((OR #1# - (ATOM #2#) - (PROGN (SETQ |x| (CAR #2#)) NIL) - (PROGN - (PROGN - (SPADLET |a| (CAR |x|)) - (SPADLET |b| (CDR |x|)) - |x|) - NIL)) - #0#) - (SEQ - (EXIT - (COND - ((NULL (|containedRight| |a| |alist|)) - (SETQ #0# (OR #0# |x|)))))))))) - (EXIT - (|findSubstitutionOrder?,fn| - (|delete| |choice| |alist|) - (CONS |choice| |res|)))) - (EXIT NIL))))) + (PROG (|a| |b| |choice|) + (RETURN + (SEQ (IF (NULL |alist|) (EXIT (NREVERSE |res|))) + (IF (SPADLET |choice| + (PROG (G166281) + (SPADLET G166281 NIL) + (RETURN + (DO ((G166289 NIL G166281) + (G166290 |alist| (CDR G166290)) + (|x| NIL)) + ((OR G166289 (ATOM G166290) + (PROGN + (SETQ |x| (CAR G166290)) + NIL) + (PROGN + (PROGN + (SPADLET |a| (CAR |x|)) + (SPADLET |b| (CDR |x|)) + |x|) + NIL)) + G166281) + (SEQ (EXIT + (COND + ((NULL + (|containedRight| |a| |alist|)) + (SETQ G166281 + (OR G166281 |x|)))))))))) + (EXIT (|findSubstitutionOrder?,fn| + (|delete| |choice| |alist|) + (CONS |choice| |res|)))) + (EXIT NIL))))) (DEFUN |findSubstitutionOrder?| (|alist|) - (|findSubstitutionOrder?,fn| |alist| NIL)) + (|findSubstitutionOrder?,fn| |alist| NIL)) ;containedRight(x,alist)== or/[CONTAINED(x,y) for [.,:y] in alist] (DEFUN |containedRight| (|x| |alist|) - (PROG (|y|) - (RETURN - (SEQ - (PROG (#0=#:G166312) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166319 NIL #0#) - (#2=#:G166320 |alist| (CDR #2#)) - (#3=#:G166309 NIL)) - ((OR #1# - (ATOM #2#) - (PROGN (SETQ #3# (CAR #2#)) NIL) - (PROGN (PROGN (SPADLET |y| (CDR #3#)) #3#) NIL)) - #0#) - (SEQ (EXIT (SETQ #0# (OR #0# (CONTAINED |x| |y|)))))))))))) + (PROG (|y|) + (RETURN + (SEQ (PROG (G166312) + (SPADLET G166312 NIL) + (RETURN + (DO ((G166319 NIL G166312) + (G166320 |alist| (CDR G166320)) + (G166309 NIL)) + ((OR G166319 (ATOM G166320) + (PROGN (SETQ G166309 (CAR G166320)) NIL) + (PROGN + (PROGN + (SPADLET |y| (CDR G166309)) + G166309) + NIL)) + G166312) + (SEQ (EXIT (SETQ G166312 + (OR G166312 (CONTAINED |x| |y|)))))))))))) ;removeIsDomainD pred == ; pred is ['isDomain,'D,D] => @@ -354,61 +386,62 @@ ; nil (DEFUN |removeIsDomainD| (|pred|) - (PROG (|preds| |ISTMP#1| |ISTMP#2| D1 D |npreds|) - (RETURN - (SEQ - (COND - ((AND (PAIRP |pred|) - (EQ (QCAR |pred|) (QUOTE |isDomain|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |pred|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) (QUOTE D)) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET D (QCAR |ISTMP#2|)) (QUOTE T))))))) - (CONS D (CONS NIL NIL))) - ((AND (PAIRP |pred|) - (EQ (QCAR |pred|) (QUOTE AND)) - (PROGN (SPADLET |preds| (QCDR |pred|)) (QUOTE T))) - (SPADLET D NIL) - (SEQ - (DO ((#0=#:G166369 |preds| (CDR #0#)) (|p| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |p| (CAR #0#)) NIL) (NULL (NULL D))) - NIL) - (SEQ - (EXIT - (COND - ((AND (PAIRP |p|) - (EQ (QCAR |p|) (QUOTE |isDomain|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |p|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) (QUOTE D)) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET D1 (QCAR |ISTMP#2|)) - (QUOTE T))))))) - (EXIT - (PROGN - (SPADLET D D1) - (SPADLET |npreds| - (|delete| - (CONS (QUOTE |isDomain|) (CONS (QUOTE D) (CONS D1 NIL))) - |preds|))))))))) - (COND - (D - (EXIT - (COND - ((EQL 1 (|#| |npreds|)) (CONS D (CONS (CAR |npreds|) NIL))) - ((QUOTE T) (CONS D (CONS (CONS (QUOTE AND) |npreds|) NIL))))))) - NIL)) - ((QUOTE T) NIL)))))) + (PROG (|preds| |ISTMP#1| |ISTMP#2| D1 D |npreds|) + (RETURN + (SEQ (COND + ((AND (PAIRP |pred|) (EQ (QCAR |pred|) '|isDomain|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |pred|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) 'D) + (PROGN + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET D (QCAR |ISTMP#2|)) + 'T)))))) + (CONS D (CONS NIL NIL))) + ((AND (PAIRP |pred|) (EQ (QCAR |pred|) 'AND) + (PROGN (SPADLET |preds| (QCDR |pred|)) 'T)) + (SPADLET D NIL) + (SEQ (DO ((G166369 |preds| (CDR G166369)) (|p| NIL)) + ((OR (ATOM G166369) + (PROGN (SETQ |p| (CAR G166369)) NIL) + (NULL (NULL D))) + NIL) + (SEQ (EXIT (COND + ((AND (PAIRP |p|) + (EQ (QCAR |p|) '|isDomain|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |p|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCAR |ISTMP#1|) 'D) + (PROGN + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET D1 + (QCAR |ISTMP#2|)) + 'T)))))) + (EXIT + (PROGN + (SPADLET D D1) + (SPADLET |npreds| + (|delete| + (CONS '|isDomain| + (CONS 'D (CONS D1 NIL))) + |preds|))))))))) + (COND + (D (EXIT (COND + ((EQL 1 (|#| |npreds|)) + (CONS D (CONS (CAR |npreds|) NIL))) + ('T + (CONS D + (CONS (CONS 'AND |npreds|) NIL))))))) + NIL)) + ('T NIL)))))) ;formatModemap modemap == ; [[dc,target,:sl],pred,:.]:= modemap @@ -450,102 +483,101 @@ ; concat(firstPart,'%l,predPart) (DEFUN |formatModemap,fn| (|l|) - (SEQ - (IF (NULL |l|) (EXIT NIL)) - (EXIT - (|concat| - (QUOTE |,|) - (|prefix2String| (CAR |l|)) - (|formatModemap,fn| (CDR |l|)))))) + (SEQ (IF (NULL |l|) (EXIT NIL)) + (EXIT (|concat| '|,| (|prefix2String| (CAR |l|)) + (|formatModemap,fn| (CDR |l|)))))) (DEFUN |formatModemap| (|modemap|) - (PROG (|alist| |dc| |ISTMP#1| D |ISTMP#2| |npred| |pred| |target| |sl| - |predPart| |targetPart| |argTypeList| |argPart| |fromPart| - |secondPart| |firstPart|) - (RETURN - (PROGN - (SPADLET |dc| (CAAR |modemap|)) - (SPADLET |target| (CADAR |modemap|)) - (SPADLET |sl| (CDDAR |modemap|)) - (SPADLET |pred| (CADR |modemap|)) - (COND - ((SPADLET |alist| (|canRemoveIsDomain?| |pred|)) - (SPADLET |dc| (|substInOrder| |alist| |dc|)) - (SPADLET |pred| (|substInOrder| |alist| (|removeIsDomains| |pred|))) - (SPADLET |target| (|substInOrder| |alist| |target|)) - (SPADLET |sl| (|substInOrder| |alist| |sl|))) - ((PROGN - (SPADLET |ISTMP#1| (|removeIsDomainD| |pred|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET D (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |npred| (QCAR |ISTMP#2|)) (QUOTE T)))))) - (SPADLET |pred| (MSUBST D (QUOTE D) |npred|)) - (SPADLET |target| (MSUBST D (QUOTE D) |target|)) - (SPADLET |sl| (MSUBST D (QUOTE D) |sl|))) - ((QUOTE T) NIL)) - (SPADLET |predPart| (|formatIf| |pred|)) - (SPADLET |targetPart| (|prefix2String| |target|)) - (SPADLET |argTypeList| - (COND - ((NULL |sl|) NIL) - ((QUOTE T) - (|concat| - (|prefix2String| (CAR |sl|)) - (|formatModemap,fn| (CDR |sl|)))))) - (SPADLET |argPart| - (COND - ((QSLESSP (|#| |sl|) 2) |argTypeList|) - ((QUOTE T) - (CONS "(" (APPEND |argTypeList| (CONS ")" NIL)))))) - (SPADLET |fromPart| - (COND - ((AND (BOOT-EQUAL |dc| (QUOTE D)) D) - (|concat| - (QUOTE |%b|) - (MAKESTRING "from") - (QUOTE |%d|) - (|prefix2String| D))) - ((QUOTE T) - (|concat| (QUOTE |%b|) "from" (QUOTE |%d|) (|prefix2String| |dc|))))) - (SPADLET |firstPart| (|concat| " " |argPart| " -> " |targetPart|)) - (COND - ((> (PLUS (|sayWidth| |firstPart|) (|sayWidth| |fromPart|)) 74) - (SPADLET |fromPart| (|concat| (MAKESTRING " ") |fromPart|)) - (SPADLET |secondPart| - (COND - ((> 75 (PLUS (|sayWidth| |fromPart|) (|sayWidth| |predPart|))) - (|concat| |fromPart| |predPart|)) - ((QUOTE T) (|concat| |fromPart| (QUOTE |%l|) |predPart|)))) - (|concat| |firstPart| (QUOTE |%l|) |secondPart|)) - ((QUOTE T) - (SPADLET |firstPart| (|concat| |firstPart| |fromPart|)) - (COND - ((> 80 (PLUS (|sayWidth| |firstPart|) (|sayWidth| |predPart|))) - (|concat| |firstPart| |predPart|)) - ((QUOTE T) (|concat| |firstPart| (QUOTE |%l|) |predPart|))))))))) + (PROG (|alist| |dc| |ISTMP#1| D |ISTMP#2| |npred| |pred| |target| + |sl| |predPart| |targetPart| |argTypeList| |argPart| + |fromPart| |secondPart| |firstPart|) + (RETURN + (PROGN + (SPADLET |dc| (CAAR |modemap|)) + (SPADLET |target| (CADAR |modemap|)) + (SPADLET |sl| (CDDAR |modemap|)) + (SPADLET |pred| (CADR |modemap|)) + (COND + ((SPADLET |alist| (|canRemoveIsDomain?| |pred|)) + (SPADLET |dc| (|substInOrder| |alist| |dc|)) + (SPADLET |pred| + (|substInOrder| |alist| (|removeIsDomains| |pred|))) + (SPADLET |target| (|substInOrder| |alist| |target|)) + (SPADLET |sl| (|substInOrder| |alist| |sl|))) + ((PROGN + (SPADLET |ISTMP#1| (|removeIsDomainD| |pred|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET D (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (PROGN (SPADLET |npred| (QCAR |ISTMP#2|)) 'T))))) + (SPADLET |pred| (MSUBST D 'D |npred|)) + (SPADLET |target| (MSUBST D 'D |target|)) + (SPADLET |sl| (MSUBST D 'D |sl|))) + ('T NIL)) + (SPADLET |predPart| (|formatIf| |pred|)) + (SPADLET |targetPart| (|prefix2String| |target|)) + (SPADLET |argTypeList| + (COND + ((NULL |sl|) NIL) + ('T + (|concat| (|prefix2String| (CAR |sl|)) + (|formatModemap,fn| (CDR |sl|)))))) + (SPADLET |argPart| + (COND + ((QSLESSP (|#| |sl|) 2) |argTypeList|) + ('T + (CONS "(" (APPEND |argTypeList| (CONS ")" NIL)))))) + (SPADLET |fromPart| + (COND + ((AND (BOOT-EQUAL |dc| 'D) D) + (|concat| '|%b| (MAKESTRING "from") '|%d| + (|prefix2String| D))) + ('T + (|concat| '|%b| "from" '|%d| + (|prefix2String| |dc|))))) + (SPADLET |firstPart| + (|concat| " " |argPart| " -> " |targetPart|)) + (COND + ((> (PLUS (|sayWidth| |firstPart|) (|sayWidth| |fromPart|)) + 74) + (SPADLET |fromPart| (|concat| (MAKESTRING " ") |fromPart|)) + (SPADLET |secondPart| + (COND + ((> 75 + (PLUS (|sayWidth| |fromPart|) + (|sayWidth| |predPart|))) + (|concat| |fromPart| |predPart|)) + ('T (|concat| |fromPart| '|%l| |predPart|)))) + (|concat| |firstPart| '|%l| |secondPart|)) + ('T (SPADLET |firstPart| (|concat| |firstPart| |fromPart|)) + (COND + ((> 80 + (PLUS (|sayWidth| |firstPart|) + (|sayWidth| |predPart|))) + (|concat| |firstPart| |predPart|)) + ('T (|concat| |firstPart| '|%l| |predPart|))))))))) ;substInOrder(alist,x) == ; alist is [[a,:b],:y] => substInOrder(y,SUBST(b,a,x)) ; x (DEFUN |substInOrder| (|alist| |x|) - (PROG (|ISTMP#1| |a| |b| |y|) - (RETURN - (COND - ((AND (PAIRP |alist|) - (PROGN (SPADLET |ISTMP#1| (QCAR |alist|)) - (AND (PAIRP |ISTMP#1|) - (PROGN + (PROG (|ISTMP#1| |a| |b| |y|) + (RETURN + (COND + ((AND (PAIRP |alist|) + (PROGN + (SPADLET |ISTMP#1| (QCAR |alist|)) + (AND (PAIRP |ISTMP#1|) + (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |b| (QCDR |ISTMP#1|)) - (QUOTE T)))) - (PROGN (SPADLET |y| (QCDR |alist|)) (QUOTE T))) - (|substInOrder| |y| (MSUBST |b| |a| |x|))) - ((QUOTE T) |x|))))) + 'T))) + (PROGN (SPADLET |y| (QCDR |alist|)) 'T)) + (|substInOrder| |y| (MSUBST |b| |a| |x|))) + ('T |x|))))) ;reportOpSymbol op1 == ; op := (STRINGP op1 => INTERN op1; op1) @@ -595,107 +627,117 @@ ; nil (DEFUN |reportOpSymbol,sayMms| (|op| |mms| |label|) - (PROG (|m|) - (RETURN - (SEQ - (SPADLET |m| (|#| |mms|)) - (|sayMSG| - (SEQ - (IF (EQL |m| 1) - (EXIT - (CONS - "There is one" - (APPEND - (|bright| |label|) - (CONS "function called" (APPEND (|bright| |op|) (CONS ":" NIL))))))) - (EXIT - (CONS - "There are " - (CONS |m| - (APPEND - (|bright| |label|) - (CONS - "functions called" - (APPEND (|bright| |op|) (CONS ":" NIL))))))))) - (EXIT - (DO ((#0=#:G166477 |mms| (CDR #0#)) (|mm| NIL) (|i| 1 (QSADD1 |i|))) - ((OR (ATOM #0#) (PROGN (SETQ |mm| (CAR #0#)) NIL)) NIL) - (SEQ (EXIT (|sayModemapWithNumber| |mm| |i|))))))))) + (PROG (|m|) + (RETURN + (SEQ (SPADLET |m| (|#| |mms|)) + (|sayMSG| + (SEQ (IF (EQL |m| 1) + (EXIT (CONS "There is one" + (APPEND (|bright| |label|) + (CONS "function called" + (APPEND (|bright| |op|) + (CONS ":" NIL))))))) + (EXIT (CONS "There are " + (CONS |m| + (APPEND (|bright| |label|) + (CONS "functions called" + (APPEND (|bright| |op|) + (CONS ":" NIL))))))))) + (EXIT (DO ((G166477 |mms| (CDR G166477)) (|mm| NIL) + (|i| 1 (QSADD1 |i|))) + ((OR (ATOM G166477) + (PROGN (SETQ |mm| (CAR G166477)) NIL)) + NIL) + (SEQ (EXIT (|sayModemapWithNumber| |mm| |i|))))))))) (DEFUN |reportOpSymbol| (|op1|) - (PROG (|op| |modemaps| |x| |ok| |domlist| |dom| |mmsE| |mmsU| |doc| |docs|) - (RETURN - (SEQ - (PROGN - (SPADLET |op| (COND ((STRINGP |op1|) (INTERN |op1|)) ((QUOTE T) |op1|))) - (SPADLET |modemaps| (|getAllModemapsFromDatabase| |op| NIL)) - (COND - ((NULL |modemaps|) - (SPADLET |ok| (QUOTE T)) - (|sayKeyedMsg| (QUOTE S2IF0010) (CONS |op1| NIL)) - (COND - ((> 3 (SIZE (PNAME |op1|))) - (SPADLET |x| - (UPCASE (|queryUserKeyedMsg| (QUOTE S2IZ0060) (CONS |op1| NIL)))) - (COND - ((NULL (MEMQ (STRING2ID-N |x| 1) (QUOTE (Y YES)))) - (PROGN - (SPADLET |ok| NIL) - (|sayKeyedMsg| (QUOTE S2IZ0061) (CONS |op1| NIL))))))) - (COND (|ok| (|apropos| (CONS |op1| NIL))))) - ((QUOTE T) - (|sayNewLine|) - (SPADLET |mmsE| (SPADLET |mmsU| NIL)) - (SPADLET |domlist| NIL) - (DO ((#0=#:G166497 |modemaps| (CDR #0#)) (|mm| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |mm| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |dom| (|getDomainFromMm| |mm|)) - (PUSHNEW |dom| |domlist|) - (COND - ((OR (|isFreeFunctionFromMm| |mm|) (|isExposedConstructor| |dom|)) - (SPADLET |mmsE| (CONS |mm| |mmsE|))) - ((QUOTE T) - (SPADLET |mmsU| (CONS |mm| |mmsU|)))))))) - (COND - (|mmsE| (|reportOpSymbol,sayMms| |op| |mmsE| (MAKESTRING "exposed")))) - (COND - (|mmsU| - (COND (|mmsE| (|sayNewLine|))) - (|reportOpSymbol,sayMms| |op| |mmsU| (MAKESTRING "unexposed")))) - (DO ((#1=#:G166512 |domlist| (CDR #1#)) (|adom| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |adom| (CAR #1#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |doc| (GETDATABASE |adom| (QUOTE DOCUMENTATION))) - (SPADLET |docs| (CDR (|assoc| |op| |doc|))) - (|sayNewLine|) - (|sayBrightly| - (CONS - "Examples of " - (CONS |op| (CONS " from " (CONS |adom| NIL))))) - (|sayNewLine|) - (DO ((#2=#:G166521 |docs| (CDR #2#)) (|export| NIL)) - ((OR (ATOM #2#) (PROGN (SETQ |export| (CAR #2#)) NIL)) NIL) - (SEQ (EXIT (SAYEXAMPLE (CADR |export|))))))))) - NIL))))))) + (PROG (|op| |modemaps| |x| |ok| |domlist| |dom| |mmsE| |mmsU| |doc| + |docs|) + (RETURN + (SEQ (PROGN + (SPADLET |op| + (COND + ((STRINGP |op1|) (INTERN |op1|)) + ('T |op1|))) + (SPADLET |modemaps| + (|getAllModemapsFromDatabase| |op| NIL)) + (COND + ((NULL |modemaps|) (SPADLET |ok| 'T) + (|sayKeyedMsg| 'S2IF0010 (CONS |op1| NIL)) + (COND + ((> 3 (SIZE (PNAME |op1|))) + (SPADLET |x| + (UPCASE (|queryUserKeyedMsg| 'S2IZ0060 + (CONS |op1| NIL)))) + (COND + ((NULL (MEMQ (STRING2ID-N |x| 1) '(Y YES))) + (PROGN + (SPADLET |ok| NIL) + (|sayKeyedMsg| 'S2IZ0061 (CONS |op1| NIL))))))) + (COND (|ok| (|apropos| (CONS |op1| NIL))))) + ('T (|sayNewLine|) (SPADLET |mmsE| (SPADLET |mmsU| NIL)) + (SPADLET |domlist| NIL) + (DO ((G166497 |modemaps| (CDR G166497)) (|mm| NIL)) + ((OR (ATOM G166497) + (PROGN (SETQ |mm| (CAR G166497)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |dom| (|getDomainFromMm| |mm|)) + (PUSHNEW |dom| |domlist|) + (COND + ((OR (|isFreeFunctionFromMm| |mm|) + (|isExposedConstructor| |dom|)) + (SPADLET |mmsE| (CONS |mm| |mmsE|))) + ('T + (SPADLET |mmsU| (CONS |mm| |mmsU|)))))))) + (COND + (|mmsE| (|reportOpSymbol,sayMms| |op| |mmsE| + (MAKESTRING "exposed")))) + (COND + (|mmsU| (COND (|mmsE| (|sayNewLine|))) + (|reportOpSymbol,sayMms| |op| |mmsU| + (MAKESTRING "unexposed")))) + (DO ((G166512 |domlist| (CDR G166512)) + (|adom| NIL)) + ((OR (ATOM G166512) + (PROGN (SETQ |adom| (CAR G166512)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |doc| + (GETDATABASE |adom| + 'DOCUMENTATION)) + (SPADLET |docs| + (CDR (|assoc| |op| |doc|))) + (|sayNewLine|) + (|sayBrightly| + (CONS "Examples of " + (CONS |op| + (CONS " from " (CONS |adom| NIL))))) + (|sayNewLine|) + (DO ((G166521 |docs| (CDR G166521)) + (|export| NIL)) + ((OR (ATOM G166521) + (PROGN + (SETQ |export| (CAR G166521)) + NIL)) + NIL) + (SEQ (EXIT + (SAYEXAMPLE (CADR |export|))))))))) + NIL))))))) ;formatOpType (form:=[op,:argl]) == ; null argl => unabbrev op ; form2String [unabbrev op, :argl] (DEFUN |formatOpType| (|form|) - (PROG (|op| |argl|) - (RETURN - (PROGN - (SPADLET |op| (CAR |form|)) - (SPADLET |argl| (CDR |form|)) - (COND - ((NULL |argl|) (|unabbrev| |op|)) - ((QUOTE T) (|form2String| (CONS (|unabbrev| |op|) |argl|)))))))) + (PROG (|op| |argl|) + (RETURN + (PROGN + (SPADLET |op| (CAR |form|)) + (SPADLET |argl| (CDR |form|)) + (COND + ((NULL |argl|) (|unabbrev| |op|)) + ('T (|form2String| (CONS (|unabbrev| |op|) |argl|)))))))) ;formatOperationAlistEntry (entry:= [op,:modemaps]) == ; -- alist has entries of the form: ((op sig) . pred) @@ -709,29 +751,41 @@ ; ans (DEFUN |formatOperationAlistEntry| (|entry|) - (PROG (|op| |modemaps| |sig| |predtail| |p| |pred| |ans|) - (RETURN - (SEQ - (PROGN - (SPADLET |op| (CAR |entry|)) - (SPADLET |modemaps| (CDR |entry|)) - (SPADLET |ans| NIL) - (DO ((#0=#:G166585 |modemaps| (CDR #0#)) (#1=#:G166559 NIL)) - ((OR (ATOM #0#) (PROGN (SETQ #1# (CAR #0#)) NIL) (PROGN (PROGN (SPADLET |sig| (CAR #1#)) (SPADLET |predtail| (CDDR #1#)) #1#) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |pred| - (COND - ((AND (PAIRP |predtail|) (PROGN (SPADLET |p| (QCAR |predtail|)) (QUOTE T))) - |p|) - ((QUOTE T) - (QUOTE T)))) - (SPADLET |ans| - (CONS - (|concat| (|formatOpSignature| |op| |sig|) (|formatIf| |pred|)) - |ans|)))))) - |ans|))))) + (PROG (|op| |modemaps| |sig| |predtail| |p| |pred| |ans|) + (RETURN + (SEQ (PROGN + (SPADLET |op| (CAR |entry|)) + (SPADLET |modemaps| (CDR |entry|)) + (SPADLET |ans| NIL) + (DO ((G166585 |modemaps| (CDR G166585)) + (G166559 NIL)) + ((OR (ATOM G166585) + (PROGN (SETQ G166559 (CAR G166585)) NIL) + (PROGN + (PROGN + (SPADLET |sig| (CAR G166559)) + (SPADLET |predtail| (CDDR G166559)) + G166559) + NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |pred| + (COND + ((AND (PAIRP |predtail|) + (PROGN + (SPADLET |p| + (QCAR |predtail|)) + 'T)) + |p|) + ('T 'T))) + (SPADLET |ans| + (CONS + (|concat| + (|formatOpSignature| |op| |sig|) + (|formatIf| |pred|)) + |ans|)))))) + |ans|))))) + ;formatOperation([[op,sig],.,[fn,.,n]],domain) == ; opSigString := formatOpSignature(op,sig) @@ -740,43 +794,38 @@ ; concat(" --",opSigString) ; opSigString -(DEFUN |formatOperation| (#0=#:G166605 |domain|) - (PROG (|op| |sig| |fn| |n| |opSigString|) - (RETURN - (PROGN - (SPADLET |op| (CAAR #0#)) - (SPADLET |sig| (CADAR #0#)) - (SPADLET |fn| (CAADDR #0#)) - (SPADLET |n| (CADR (CDADDR #0#))) - (SPADLET |opSigString| (|formatOpSignature| |op| |sig|)) - (COND - ((AND (INTEGERP |n|) (BOOT-EQUAL |Undef| (KAR (ELT |domain| |n|)))) - (COND - ((INTEGERP |$commentedOps|) - (SPADLET |$commentedOps| (PLUS |$commentedOps| 1)))) - (|concat| (QUOTE | --|) |opSigString|)) - ((QUOTE T) |opSigString|)))))) +(DEFUN |formatOperation| (G166605 |domain|) + (PROG (|op| |sig| |fn| |n| |opSigString|) + (DECLARE (SPECIAL |$commentedOps|)) + (RETURN + (PROGN + (SPADLET |op| (CAAR G166605)) + (SPADLET |sig| (CADAR G166605)) + (SPADLET |fn| (CAADDR G166605)) + (SPADLET |n| (CADR (CDADDR G166605))) + (SPADLET |opSigString| (|formatOpSignature| |op| |sig|)) + (COND + ((AND (INTEGERP |n|) + (BOOT-EQUAL |Undef| (KAR (ELT |domain| |n|)))) + (COND + ((INTEGERP |$commentedOps|) + (SPADLET |$commentedOps| (PLUS |$commentedOps| 1)))) + (|concat| '| --| |opSigString|)) + ('T |opSigString|)))))) ;formatOpSignature(op,sig) == ; concat('%b,formatOpSymbol(op,sig),'%d,": ",formatSignature sig) (DEFUN |formatOpSignature| (|op| |sig|) - (|concat| - (QUOTE |%b|) - (|formatOpSymbol| |op| |sig|) - (QUOTE |%d|) - (QUOTE |: |) - (|formatSignature| |sig|))) + (|concat| '|%b| (|formatOpSymbol| |op| |sig|) '|%d| '|: | + (|formatSignature| |sig|))) ;formatOpConstant op == ; concat('%b,formatOpSymbol(op,'($)),'%d,'": constant") (DEFUN |formatOpConstant| (|op|) - (|concat| - (QUOTE |%b|) - (|formatOpSymbol| |op| (QUOTE ($))) - (QUOTE |%d|) - (MAKESTRING ": constant"))) + (|concat| '|%b| (|formatOpSymbol| |op| '($)) '|%d| + (MAKESTRING ": constant"))) ;formatOpSymbol(op,sig) == ; if op = 'Zero then op := "0" @@ -805,45 +854,50 @@ ; op (DEFUN |formatOpSymbol| (|op| |sig|) - (PROG (|quad| |n| |sel|) - (RETURN - (PROGN - (COND - ((BOOT-EQUAL |op| (QUOTE |Zero|)) (SPADLET |op| (QUOTE |0|))) - ((BOOT-EQUAL |op| (QUOTE |One|)) (SPADLET |op| (QUOTE |1|))) - ((QUOTE T) NIL)) - (COND - ((NULL |sig|) |op|) - ((QUOTE T) - (SPADLET |quad| (|specialChar| (QUOTE |quad|))) - (SPADLET |n| (|#| |sig|)) - (COND - ((AND (BOOT-EQUAL |op| (QUOTE |elt|)) (EQL |n| 3)) + (PROG (|quad| |n| |sel|) + (RETURN + (PROGN (COND - ((BOOT-EQUAL (CADR |sig|) (QUOTE $)) - (COND - ((STRINGP (SPADLET |sel| (CADDR |sig|))) - (CONS |quad| (CONS (INTERN "." "BOOT") (CONS |sel| NIL)))) - ((QUOTE T) - (CONS |quad| (CONS (INTERN "." "BOOT") (CONS |quad| NIL)))))) - ((QUOTE T) |op|))) - ((OR (STRINGP |op|) (GETL |op| (QUOTE |Led|)) (GETL |op| (QUOTE |Nud|))) + ((BOOT-EQUAL |op| '|Zero|) (SPADLET |op| '|0|)) + ((BOOT-EQUAL |op| '|One|) (SPADLET |op| '|1|)) + ('T NIL)) (COND - ((EQL |n| 3) - (COND - ((BOOT-EQUAL |op| (QUOTE SEGMENT)) - (SPADLET |op| (MAKESTRING "..")))) - (COND - ((BOOT-EQUAL |op| (QUOTE |in|)) - (CONS |quad| (CONS " " (CONS |op| (CONS " " (CONS |quad| NIL)))))) - ((BOOT-EQUAL |op| (QUOTE |exquo|)) |op|) - ((QUOTE T) (CONS |quad| (CONS |op| (CONS |quad| NIL)))))) - ((EQL |n| 2) - (COND - ((NULL (GETL |op| (QUOTE |Nud|))) (CONS |quad| (CONS |op| NIL))) - ((QUOTE T) (CONS |op| (CONS |quad| NIL))))) - ((QUOTE T) |op|))) - ((QUOTE T) |op|)))))))) + ((NULL |sig|) |op|) + ('T (SPADLET |quad| (|specialChar| '|quad|)) + (SPADLET |n| (|#| |sig|)) + (COND + ((AND (BOOT-EQUAL |op| '|elt|) (EQL |n| 3)) + (COND + ((BOOT-EQUAL (CADR |sig|) '$) + (COND + ((STRINGP (SPADLET |sel| (CADDR |sig|))) + (CONS |quad| + (CONS (INTERN "." "BOOT") (CONS |sel| NIL)))) + ('T + (CONS |quad| + (CONS (INTERN "." "BOOT") (CONS |quad| NIL)))))) + ('T |op|))) + ((OR (STRINGP |op|) (GETL |op| '|Led|) (GETL |op| '|Nud|)) + (COND + ((EQL |n| 3) + (COND + ((BOOT-EQUAL |op| 'SEGMENT) + (SPADLET |op| (MAKESTRING "..")))) + (COND + ((BOOT-EQUAL |op| '|in|) + (CONS |quad| + (CONS " " + (CONS |op| + (CONS " " (CONS |quad| NIL)))))) + ((BOOT-EQUAL |op| '|exquo|) |op|) + ('T (CONS |quad| (CONS |op| (CONS |quad| NIL)))))) + ((EQL |n| 2) + (COND + ((NULL (GETL |op| '|Nud|)) + (CONS |quad| (CONS |op| NIL))) + ('T (CONS |op| (CONS |quad| NIL))))) + ('T |op|))) + ('T |op|)))))))) ;formatAttribute x == ; atom x => [" ",x] @@ -854,29 +908,27 @@ ; [" ",op] (DEFUN |formatAttribute| (|x|) - (PROG (|op| |argl| |argPart|) - (RETURN - (SEQ - (COND - ((ATOM |x|) (CONS (QUOTE | |) (CONS |x| NIL))) - ((AND (PAIRP |x|) - (PROGN - (SPADLET |op| (QCAR |x|)) - (SPADLET |argl| (QCDR |x|)) - (QUOTE T))) - (DO ((#0=#:G166656 |argl| (CDR #0#)) (|x| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (SPADLET |argPart| - (NCONC - |argPart| - (|concat| (QUOTE |,|) (|formatAttributeArg| |x|))))))) - (COND - (|argPart| - (|concat| (QUOTE | |) |op| (QUOTE |(|) (CDR |argPart|) (QUOTE |)|))) - ((QUOTE T) - (CONS (QUOTE | |) (CONS |op| NIL)))))))))) + (PROG (|op| |argl| |argPart|) + (RETURN + (SEQ (COND + ((ATOM |x|) (CONS '| | (CONS |x| NIL))) + ((AND (PAIRP |x|) + (PROGN + (SPADLET |op| (QCAR |x|)) + (SPADLET |argl| (QCDR |x|)) + 'T)) + (DO ((G166656 |argl| (CDR G166656)) (|x| NIL)) + ((OR (ATOM G166656) + (PROGN (SETQ |x| (CAR G166656)) NIL)) + NIL) + (SEQ (EXIT (SPADLET |argPart| + (NCONC |argPart| + (|concat| '|,| + (|formatAttributeArg| |x|))))))) + (COND + (|argPart| + (|concat| '| | |op| '|(| (CDR |argPart|) '|)|)) + ('T (CONS '| | (CONS |op| NIL)))))))))) ;formatAttributeArg x == ; STRINGP x and x ='"*" => "_"*_"" @@ -886,52 +938,49 @@ ; prefix2String0 x (DEFUN |formatAttributeArg| (|x|) - (PROG (|ISTMP#1| |op| |ISTMP#2| |ISTMP#3| |sig|) - (RETURN - (COND - ((AND (STRINGP |x|) (BOOT-EQUAL |x| (MAKESTRING "*"))) (QUOTE |"*"|)) - ((ATOM |x|) (|formatOpSymbol| |x| NIL)) - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE |:|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |op| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#3|) - (EQ (QCAR |ISTMP#3|) (QUOTE |Mapping|)) - (PROGN (SPADLET |sig| (QCDR |ISTMP#3|)) (QUOTE T))))))))) - (|concat| - (QUOTE |%b|) - (|formatOpSymbol| |op| |sig|) - (QUOTE |: |) - (QUOTE |%d|) - (|formatMapping| |sig|))) - ((QUOTE T) (|prefix2String0| |x|)))))) + (PROG (|ISTMP#1| |op| |ISTMP#2| |ISTMP#3| |sig|) + (RETURN + (COND + ((AND (STRINGP |x|) (BOOT-EQUAL |x| (MAKESTRING "*"))) '|"*"|) + ((ATOM |x|) (|formatOpSymbol| |x| NIL)) + ((AND (PAIRP |x|) (EQ (QCAR |x|) '|:|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |op| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQ (QCAR |ISTMP#3|) '|Mapping|) + (PROGN + (SPADLET |sig| (QCDR |ISTMP#3|)) + 'T)))))))) + (|concat| '|%b| (|formatOpSymbol| |op| |sig|) '|: | '|%d| + (|formatMapping| |sig|))) + ('T (|prefix2String0| |x|)))))) ;formatMapping sig == ; "STRCONC"/concat("Mapping(",formatSignature sig,")") (DEFUN |formatMapping| (|sig|) - (PROG NIL - (RETURN - (SEQ - (PROG (#0=#:G166704) - (SPADLET #0# "") - (RETURN - (DO ((#1=#:G166709 - (|concat| (QUOTE |Mapping(|) (|formatSignature| |sig|) (QUOTE |)|)) - (CDR #1#)) - (#2=#:G166703 NIL)) - ((OR (ATOM #1#) (PROGN (SETQ #2# (CAR #1#)) NIL)) #0#) - (SEQ (EXIT (SETQ #0# (STRCONC #0# #2#))))))))))) + (PROG () + (RETURN + (SEQ (PROG (G166704) + (SPADLET G166704 "") + (RETURN + (DO ((G166709 + (|concat| '|Mapping(| (|formatSignature| |sig|) + '|)|) + (CDR G166709)) + (G166703 NIL)) + ((OR (ATOM G166709) + (PROGN (SETQ G166703 (CAR G166709)) NIL)) + G166704) + (SEQ (EXIT (SETQ G166704 + (STRCONC G166704 G166703))))))))))) ;dollarPercentTran x == ; -- Translate $ to %. We actually return %% so that the message @@ -945,49 +994,55 @@ ; x (DEFUN |dollarPercentTran| (|x|) - (PROG (|y| |z| |y1| |z1|) - (RETURN - (COND - ((AND (PAIRP |x|) - (PROGN (SPADLET |y| (QCAR |x|)) (SPADLET |z| (QCDR |x|)) (QUOTE T))) - (SPADLET |y1| (|dollarPercentTran| |y|)) - (SPADLET |z1| (|dollarPercentTran| |z|)) - (COND - ((AND (EQ |y| |y1|) (EQ |z| |z1|)) |x|) - ((QUOTE T) (CONS |y1| |z1|)))) - ((OR (BOOT-EQUAL |x| (QUOTE $)) (BOOT-EQUAL |x| (MAKESTRING "$"))) - (QUOTE %%)) - ((QUOTE T) |x|))))) + (PROG (|y| |z| |y1| |z1|) + (RETURN + (COND + ((AND (PAIRP |x|) + (PROGN + (SPADLET |y| (QCAR |x|)) + (SPADLET |z| (QCDR |x|)) + 'T)) + (SPADLET |y1| (|dollarPercentTran| |y|)) + (SPADLET |z1| (|dollarPercentTran| |z|)) + (COND + ((AND (EQ |y| |y1|) (EQ |z| |z1|)) |x|) + ('T (CONS |y1| |z1|)))) + ((OR (BOOT-EQUAL |x| '$) (BOOT-EQUAL |x| (MAKESTRING "$"))) + '%%) + ('T |x|))))) ;formatSignatureAsTeX sig == ; $formatSigAsTeX: local := 2 ; formatSignature0 sig (DEFUN |formatSignatureAsTeX| (|sig|) - (PROG (|$formatSigAsTeX|) - (DECLARE (SPECIAL |$formatSigAsTeX|)) - (RETURN (PROGN (SPADLET |$formatSigAsTeX| 2) (|formatSignature0| |sig|))))) + (PROG (|$formatSigAsTeX|) + (DECLARE (SPECIAL |$formatSigAsTeX|)) + (RETURN + (PROGN (SPADLET |$formatSigAsTeX| 2) (|formatSignature0| |sig|))))) ;formatSignature sig == ; $formatSigAsTeX: local := 1 ; formatSignature0 sig (DEFUN |formatSignature| (|sig|) - (PROG (|$formatSigAsTeX|) - (DECLARE (SPECIAL |$formatSigAsTeX|)) - (RETURN (PROGN (SPADLET |$formatSigAsTeX| 1) (|formatSignature0| |sig|))))) + (PROG (|$formatSigAsTeX|) + (DECLARE (SPECIAL |$formatSigAsTeX|)) + (RETURN + (PROGN (SPADLET |$formatSigAsTeX| 1) (|formatSignature0| |sig|))))) ;formatSignatureArgs sml == ; $formatSigAsTeX: local := 1 ; formatSignatureArgs0 sml (DEFUN |formatSignatureArgs| (|sml|) - (PROG (|$formatSigAsTeX|) - (DECLARE (SPECIAL |$formatSigAsTeX|)) - (RETURN - (PROGN (SPADLET |$formatSigAsTeX| 1) (|formatSignatureArgs0| |sml|))))) + (PROG (|$formatSigAsTeX|) + (DECLARE (SPECIAL |$formatSigAsTeX|)) + (RETURN + (PROGN + (SPADLET |$formatSigAsTeX| 1) + (|formatSignatureArgs0| |sml|))))) -; ;formatSignature0 sig == ; null sig => "() -> ()" ; INTEGERP sig => '"hashcode" @@ -997,18 +1052,16 @@ ; dollarPercentTran concat(sourcePart,concat(" -> ",targetPart)) (DEFUN |formatSignature0| (|sig|) - (PROG (|tm| |sml| |sourcePart| |targetPart|) - (RETURN - (COND - ((NULL |sig|) (QUOTE |() -> ()|)) - ((INTEGERP |sig|) (MAKESTRING "hashcode")) - ((QUOTE T) - (SPADLET |tm| (CAR |sig|)) - (SPADLET |sml| (CDR |sig|)) - (SPADLET |sourcePart| (|formatSignatureArgs0| |sml|)) - (SPADLET |targetPart| (|prefix2String0| |tm|)) - (|dollarPercentTran| - (|concat| |sourcePart| (|concat| (QUOTE | -> |) |targetPart|)))))))) + (PROG (|tm| |sml| |sourcePart| |targetPart|) + (RETURN + (COND + ((NULL |sig|) '|() -> ()|) + ((INTEGERP |sig|) (MAKESTRING "hashcode")) + ('T (SPADLET |tm| (CAR |sig|)) (SPADLET |sml| (CDR |sig|)) + (SPADLET |sourcePart| (|formatSignatureArgs0| |sml|)) + (SPADLET |targetPart| (|prefix2String0| |tm|)) + (|dollarPercentTran| + (|concat| |sourcePart| (|concat| '| -> | |targetPart|)))))))) ;formatSignatureArgs0(sml) == ;-- formats the arguments of a signature @@ -1020,23 +1073,21 @@ ; concat("_(",concat(argList,"_)")) (DEFUN |formatSignatureArgs0| (|sml|) - (PROG (|argList|) - (RETURN - (SEQ - (COND - ((NULL |sml|) (CONS (QUOTE |()|) NIL)) - ((NULL (CDR |sml|)) (|prefix2String0| (CAR |sml|))) - ((QUOTE T) - (SPADLET |argList| (|prefix2String0| (CAR |sml|))) - (DO ((#0=#:G166767 (CDR |sml|) (CDR #0#)) (|m| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |m| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (SPADLET |argList| - (|concat| - |argList| - (|concat| (QUOTE |,|) (|prefix2String0| |m|))))))) - (|concat| (QUOTE |(|) (|concat| |argList| (QUOTE |)|))))))))) + (PROG (|argList|) + (RETURN + (SEQ (COND + ((NULL |sml|) (CONS '|()| NIL)) + ((NULL (CDR |sml|)) (|prefix2String0| (CAR |sml|))) + ('T (SPADLET |argList| (|prefix2String0| (CAR |sml|))) + (DO ((G166767 (CDR |sml|) (CDR G166767)) (|m| NIL)) + ((OR (ATOM G166767) + (PROGN (SETQ |m| (CAR G166767)) NIL)) + NIL) + (SEQ (EXIT (SPADLET |argList| + (|concat| |argList| + (|concat| '|,| + (|prefix2String0| |m|))))))) + (|concat| '|(| (|concat| |argList| '|)|)))))))) ;--% Conversions to string form ;expr2String x == @@ -1044,24 +1095,27 @@ ; "STRCONC"/[atom2String y for y in u] (DEFUN |expr2String| (|x|) - (PROG (|u|) - (RETURN - (SEQ - (COND - ((ATOM (SPADLET |u| (|prefix2String0| |x|))) |u|) - ((QUOTE T) - (PROG (#0=#:G166779) - (SPADLET #0# "") - (RETURN - (DO ((#1=#:G166784 |u| (CDR #1#)) (|y| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) #0#) - (SEQ (EXIT (SETQ #0# (STRCONC #0# (|atom2String| |y|)))))))))))))) + (PROG (|u|) + (RETURN + (SEQ (COND + ((ATOM (SPADLET |u| (|prefix2String0| |x|))) |u|) + ('T + (PROG (G166779) + (SPADLET G166779 "") + (RETURN + (DO ((G166784 |u| (CDR G166784)) (|y| NIL)) + ((OR (ATOM G166784) + (PROGN (SETQ |y| (CAR G166784)) NIL)) + G166779) + (SEQ (EXIT (SETQ G166779 + (STRCONC G166779 + (|atom2String| |y|)))))))))))))) ;-- exports (this is a badly named bit of sillyness) ;prefix2StringAsTeX form == ; form2StringAsTeX form -(DEFUN |prefix2StringAsTeX| (|form|) (|form2StringAsTeX| |form|)) +(DEFUN |prefix2StringAsTeX| (|form|) (|form2StringAsTeX| |form|)) ;prefix2String form == ; form2String form @@ -1090,24 +1144,18 @@ ; s (DEFUN |form2StringWithWhere| (|u|) - (PROG (|$permitWhere| |$whereList| |s|) - (DECLARE (SPECIAL |$permitWhere| |$whereList|)) - (RETURN - (PROGN - (SPADLET |$permitWhere| (QUOTE T)) - (SPADLET |$whereList| NIL) - (SPADLET |s| (|form2String| |u|)) - (COND - (|$whereList| - (|concat| - |s| - (QUOTE |%b|) - "where" - (QUOTE |%d|) - (QUOTE |%i|) - |$whereList| - (QUOTE |%u|))) - ((QUOTE T) |s|)))))) + (PROG (|$permitWhere| |$whereList| |s|) + (DECLARE (SPECIAL |$permitWhere| |$whereList|)) + (RETURN + (PROGN + (SPADLET |$permitWhere| 'T) + (SPADLET |$whereList| NIL) + (SPADLET |s| (|form2String| |u|)) + (COND + (|$whereList| + (|concat| |s| '|%b| "where" '|%d| '|%i| |$whereList| + '|%u|)) + ('T |s|)))))) ;form2StringWithPrens form == ; null (argl := rest form) => [first form] @@ -1115,15 +1163,14 @@ ; form2String form (DEFUN |form2StringWithPrens| (|form|) - (PROG (|argl|) - (RETURN - (COND - ((NULL (SPADLET |argl| (CDR |form|))) (CONS (CAR |form|) NIL)) - ((NULL (CDR |argl|)) - (CONS - (CAR |form|) - (CONS (QUOTE |(|) (CONS (CAR |argl|) (CONS (QUOTE |)|) NIL))))) - ((QUOTE T) (|form2String| |form|)))))) + (PROG (|argl|) + (RETURN + (COND + ((NULL (SPADLET |argl| (CDR |form|))) (CONS (CAR |form|) NIL)) + ((NULL (CDR |argl|)) + (CONS (CAR |form|) + (CONS '|(| (CONS (CAR |argl|) (CONS '|)| NIL))))) + ('T (|form2String| |form|)))))) ;formString u == ; x := form2String u @@ -1131,38 +1178,43 @@ ; "STRCONC"/[STRINGIMAGE y for y in x] (DEFUN |formString| (|u|) - (PROG (|x|) - (RETURN - (SEQ - (PROGN - (SPADLET |x| (|form2String| |u|)) - (COND - ((ATOM |x|) (STRINGIMAGE |x|)) - ((QUOTE T) - (PROG (#0=#:G166821) - (SPADLET #0# "") - (RETURN - (DO ((#1=#:G166826 |x| (CDR #1#)) (|y| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) #0#) - (SEQ (EXIT (SETQ #0# (STRCONC #0# (STRINGIMAGE |y|))))))))))))))) + (PROG (|x|) + (RETURN + (SEQ (PROGN + (SPADLET |x| (|form2String| |u|)) + (COND + ((ATOM |x|) (STRINGIMAGE |x|)) + ('T + (PROG (G166821) + (SPADLET G166821 "") + (RETURN + (DO ((G166826 |x| (CDR G166826)) (|y| NIL)) + ((OR (ATOM G166826) + (PROGN (SETQ |y| (CAR G166826)) NIL)) + G166821) + (SEQ (EXIT (SETQ G166821 + (STRCONC G166821 + (STRINGIMAGE |y|))))))))))))))) ;form2String u == ; $formatSigAsTeX: local := 1 ; form2StringLocal u (DEFUN |form2String| (|u|) - (PROG (|$formatSigAsTeX|) - (DECLARE (SPECIAL |$formatSigAsTeX|)) - (RETURN (PROGN (SPADLET |$formatSigAsTeX| 1) (|form2StringLocal| |u|))))) + (PROG (|$formatSigAsTeX|) + (DECLARE (SPECIAL |$formatSigAsTeX|)) + (RETURN + (PROGN (SPADLET |$formatSigAsTeX| 1) (|form2StringLocal| |u|))))) ;form2StringAsTeX u == ; $formatSigAsTeX: local := 2 ; form2StringLocal u (DEFUN |form2StringAsTeX| (|u|) - (PROG (|$formatSigAsTeX|) - (DECLARE (SPECIAL |$formatSigAsTeX|)) - (RETURN (PROGN (SPADLET |$formatSigAsTeX| 2) (|form2StringLocal| |u|))))) + (PROG (|$formatSigAsTeX|) + (DECLARE (SPECIAL |$formatSigAsTeX|)) + (RETURN + (PROGN (SPADLET |$formatSigAsTeX| 2) (|form2StringLocal| |u|))))) ;form2StringLocal u == ;--+ @@ -1171,22 +1223,21 @@ ; form2String1 u (DEFUN |form2StringLocal| (|u|) - (PROG (|$NRTmonitorIfTrue| |$fortInts2Floats|) - (DECLARE (SPECIAL |$NRTmonitorIfTrue| |$fortInts2Floats|)) - (RETURN - (PROGN - (SPADLET |$NRTmonitorIfTrue| NIL) - (SPADLET |$fortInts2Floats| NIL) - (|form2String1| |u|))))) + (PROG (|$NRTmonitorIfTrue| |$fortInts2Floats|) + (DECLARE (SPECIAL |$NRTmonitorIfTrue| |$fortInts2Floats|)) + (RETURN + (PROGN + (SPADLET |$NRTmonitorIfTrue| NIL) + (SPADLET |$fortInts2Floats| NIL) + (|form2String1| |u|))))) ;constructorName con == ; $abbreviateTypes => abbreviate con ; con (DEFUN |constructorName| (|con|) - (COND - (|$abbreviateTypes| (|abbreviate| |con|)) - ((QUOTE T) |con|))) + (DECLARE (SPECIAL |$abbreviateTypes|)) + (COND (|$abbreviateTypes| (|abbreviate| |con|)) ('T |con|))) ;form2String1 u == ; ATOM u => @@ -1252,159 +1303,205 @@ ; application2String(op,[form2String1 x for x in argl], u1) (DEFUN |form2String1| (|u|) - (PROG (|u1| |op| |conSig| |ml| |argl'| |operation| |sig| |lo| |argl|) - (RETURN - (SEQ - (COND - ((ATOM |u|) - (COND - ((OR (BOOT-EQUAL |u| |$EmptyMode|) (BOOT-EQUAL |u| |$quadSymbol|)) - (|formWrapId| (|specialChar| (QUOTE |quad|)))) - ((IDENTP |u|) - (COND - ((|constructor?| |u|) - (|app2StringWrap| (|formWrapId| |u|) (CONS |u| NIL))) - ((QUOTE T) |u|))) - ((SUBRP |u|) (|formWrapId| (BPINAME |u|))) - ((STRINGP |u|) (|formWrapId| |u|)) - ((QUOTE T) (WRITE-TO-STRING (|formWrapId| |u|))))) - ((QUOTE T) - (SPADLET |u1| |u|) - (SPADLET |op| (CAR |u|)) - (SPADLET |argl| (CDR |u|)) - (COND - ((OR (BOOT-EQUAL |op| (QUOTE |Join|)) - (BOOT-EQUAL |op| (QUOTE |mkCategory|))) - (|formJoin1| |op| |argl|)) - ((AND |$InteractiveMode| (SPADLET |u| (|constructor?| |op|))) - (COND - ((NULL |argl|) - (|app2StringWrap| (|formWrapId| (|constructorName| |op|)) |u1|)) - ((BOOT-EQUAL |op| (QUOTE |NTuple|)) - (CONS (|form2String1| (CAR |argl|)) (CONS (QUOTE *) NIL))) - ((BOOT-EQUAL |op| (QUOTE |Map|)) - (CONS - (QUOTE |(|) - (APPEND - (|formatSignature0| - (CONS (ELT |argl| 1) (CONS (ELT |argl| 0) NIL))) - (CONS (QUOTE |)|) NIL)))) - ((BOOT-EQUAL |op| (QUOTE |Record|)) (|record2String| |argl|)) - ((NULL (SPADLET |conSig| (|getConstructorSignature| |op|))) - (|application2String| - (|constructorName| |op|) - (PROG (#0=#:G166881) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166886 |argl| (CDR #1#)) (|a| NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ |a| (CAR #1#)) NIL)) - (NREVERSE0 #0#)) - (SEQ (EXIT (SETQ #0# (CONS (|form2String1| |a|) #0#))))))) |u1|)) - ((QUOTE T) - (SPADLET |ml| (CDR |conSig|)) - (COND - ((NULL (|freeOfSharpVars| |ml|)) - (SPADLET |ml| - (SUBLIS - (PROG (#2=#:G166897) - (SPADLET #2# NIL) - (RETURN - (DO ((#3=#:G166903 |$FormalMapVariableList| (CDR #3#)) - (|pvar| NIL) - (#4=#:G166904 |argl| (CDR #4#)) - (|val| NIL)) - ((OR (ATOM #3#) - (PROGN (SETQ |pvar| (CAR #3#)) NIL) - (ATOM #4#) - (PROGN (SETQ |val| (CAR #4#)) NIL)) - (NREVERSE0 #2#)) - (SEQ - (EXIT (SETQ #2# (CONS (CONS |pvar| |val|) #2#))))))) |ml|)))) - (SPADLET |argl| (|formArguments2String| |argl| |ml|)) - (COND - ((NULL |argl|) (|constructorName| |op|)) - ((QUOTE T) - (|application2String| (|constructorName| |op|) |argl| |u1|)))))) - ((BOOT-EQUAL |op| (QUOTE |Mapping|)) - (CONS - (QUOTE |(|) - (APPEND (|formatSignature| |argl|) (CONS (QUOTE |)|) NIL)))) - ((BOOT-EQUAL |op| (QUOTE |Record|)) (|record2String| |argl|)) - ((BOOT-EQUAL |op| (QUOTE |Union|)) - (|application2String| - |op| - (PROG (#5=#:G166917) - (SPADLET #5# NIL) - (RETURN - (DO ((#6=#:G166922 |argl| (CDR #6#)) (|x| NIL)) - ((OR (ATOM #6#) (PROGN (SETQ |x| (CAR #6#)) NIL)) - (NREVERSE0 #5#)) - (SEQ (EXIT (SETQ #5# (CONS (|form2String1| |x|) #5#))))))) - |u1|)) - ((BOOT-EQUAL |op| (QUOTE |:|)) - (COND - ((NULL |argl|) (CONS (MAKESTRING ":") NIL)) - ((NULL (CDR |argl|)) - (CONS (MAKESTRING ":") (CONS (|form2String1| (CAR |argl|)) NIL))) - ((QUOTE T) (|formDecl2String| (ELT |argl| 0) (ELT |argl| 1))))) - ((AND (BOOT-EQUAL |op| (QUOTE |#|)) (PAIRP |argl|) (LISTP (CAR |argl|))) - (STRINGIMAGE (SIZE (CAR |argl|)))) - ((BOOT-EQUAL |op| (QUOTE |Join|)) (|formJoin2String| |argl|)) - ((BOOT-EQUAL |op| (QUOTE ATTRIBUTE)) (|form2String1| (CAR |argl|))) - ((BOOT-EQUAL |op| (QUOTE |Zero|)) 0) - ((BOOT-EQUAL |op| (QUOTE |One|)) 1) - ((BOOT-EQUAL |op| (QUOTE AGGLST)) (|tuple2String| |argl|)) - ((BOOT-EQUAL |op| (QUOTE BRACKET)) - (SPADLET |argl'| (|form2String1| (CAR |argl|))) - (CONS - (QUOTE [) - (APPEND - (COND ((ATOM |argl'|) (CONS |argl'| NIL)) ((QUOTE T) |argl'|)) - (CONS (QUOTE ]) NIL)))) - ((BOOT-EQUAL |op| (QUOTE SIGNATURE)) - (SPADLET |operation| (CAR |argl|)) - (SPADLET |sig| (CADR |argl|)) - (|concat| |operation| (QUOTE |: |) (|formatSignature| |sig|))) - ((BOOT-EQUAL |op| (QUOTE COLLECT)) (|formCollect2String| |argl|)) - ((BOOT-EQUAL |op| (QUOTE |construct|)) - (|concat| - (|lbrkSch|) - (|tuple2String| - (PROG (#7=#:G166932) - (SPADLET #7# NIL) - (RETURN - (DO ((#8=#:G166937 |argl| (CDR #8#)) (|x| NIL)) - ((OR (ATOM #8#) - (PROGN (SETQ |x| (CAR #8#)) NIL)) - (NREVERSE0 #7#)) - (SEQ (EXIT (SETQ #7# (CONS (|form2String1| |x|) #7#)))))))) - (|rbrkSch|))) - ((BOOT-EQUAL |op| (QUOTE SEGMENT)) - (COND - ((NULL |argl|) (MAKESTRING "..")) - ((QUOTE T) - (SPADLET |lo| (|form2String1| (CAR |argl|))) - (SPADLET |argl| (CDR |argl|)) - (COND - ((OR (NULL |argl|) (NULL (CAR |argl|))) - (CONS |lo| (CONS (MAKESTRING "..") NIL))) - ((QUOTE T) - (CONS - |lo| - (CONS ".." (CONS (|form2String1| (CAR |argl|)) NIL)))))))) - ((|isBinaryInfix| |op|) (|fortexp0| (CONS |op| |argl|))) - ((QUOTE T) - (|application2String| - |op| - (PROG (#9=#:G166947) - (SPADLET #9# NIL) - (RETURN - (DO ((#10=#:G166952 |argl| (CDR #10#)) (|x| NIL)) - ((OR (ATOM #10#) (PROGN (SETQ |x| (CAR #10#)) NIL)) - (NREVERSE0 #9#)) - (SEQ (EXIT (SETQ #9# (CONS (|form2String1| |x|) #9#))))))) - |u1|))))))))) + (PROG (|u1| |op| |conSig| |ml| |argl'| |operation| |sig| |lo| |argl|) + (DECLARE (SPECIAL |$FormalMapVariableList| |$InteractiveMode| + |$quadSymbol| |$EmptyMode|)) + (RETURN + (SEQ (COND + ((ATOM |u|) + (COND + ((OR (BOOT-EQUAL |u| |$EmptyMode|) + (BOOT-EQUAL |u| |$quadSymbol|)) + (|formWrapId| (|specialChar| '|quad|))) + ((IDENTP |u|) + (COND + ((|constructor?| |u|) + (|app2StringWrap| (|formWrapId| |u|) + (CONS |u| NIL))) + ('T |u|))) + ((SUBRP |u|) (|formWrapId| (BPINAME |u|))) + ((STRINGP |u|) (|formWrapId| |u|)) + ('T (WRITE-TO-STRING (|formWrapId| |u|))))) + ('T (SPADLET |u1| |u|) (SPADLET |op| (CAR |u|)) + (SPADLET |argl| (CDR |u|)) + (COND + ((OR (BOOT-EQUAL |op| '|Join|) + (BOOT-EQUAL |op| '|mkCategory|)) + (|formJoin1| |op| |argl|)) + ((AND |$InteractiveMode| + (SPADLET |u| (|constructor?| |op|))) + (COND + ((NULL |argl|) + (|app2StringWrap| + (|formWrapId| (|constructorName| |op|)) |u1|)) + ((BOOT-EQUAL |op| '|NTuple|) + (CONS (|form2String1| (CAR |argl|)) (CONS '* NIL))) + ((BOOT-EQUAL |op| '|Map|) + (CONS '|(| + (APPEND (|formatSignature0| + (CONS (ELT |argl| 1) + (CONS (ELT |argl| 0) NIL))) + (CONS '|)| NIL)))) + ((BOOT-EQUAL |op| '|Record|) + (|record2String| |argl|)) + ((NULL (SPADLET |conSig| + (|getConstructorSignature| |op|))) + (|application2String| (|constructorName| |op|) + (PROG (G166881) + (SPADLET G166881 NIL) + (RETURN + (DO ((G166886 |argl| (CDR G166886)) + (|a| NIL)) + ((OR (ATOM G166886) + (PROGN + (SETQ |a| (CAR G166886)) + NIL)) + (NREVERSE0 G166881)) + (SEQ (EXIT + (SETQ G166881 + (CONS (|form2String1| |a|) + G166881))))))) + |u1|)) + ('T (SPADLET |ml| (CDR |conSig|)) + (COND + ((NULL (|freeOfSharpVars| |ml|)) + (SPADLET |ml| + (SUBLIS (PROG (G166897) + (SPADLET G166897 NIL) + (RETURN + (DO + ((G166903 + |$FormalMapVariableList| + (CDR G166903)) + (|pvar| NIL) + (G166904 |argl| + (CDR G166904)) + (|val| NIL)) + ((OR (ATOM G166903) + (PROGN + (SETQ |pvar| + (CAR G166903)) + NIL) + (ATOM G166904) + (PROGN + (SETQ |val| + (CAR G166904)) + NIL)) + (NREVERSE0 G166897)) + (SEQ + (EXIT + (SETQ G166897 + (CONS + (CONS |pvar| |val|) + G166897))))))) + |ml|)))) + (SPADLET |argl| + (|formArguments2String| |argl| |ml|)) + (COND + ((NULL |argl|) (|constructorName| |op|)) + ('T + (|application2String| (|constructorName| |op|) + |argl| |u1|)))))) + ((BOOT-EQUAL |op| '|Mapping|) + (CONS '|(| + (APPEND (|formatSignature| |argl|) + (CONS '|)| NIL)))) + ((BOOT-EQUAL |op| '|Record|) (|record2String| |argl|)) + ((BOOT-EQUAL |op| '|Union|) + (|application2String| |op| + (PROG (G166917) + (SPADLET G166917 NIL) + (RETURN + (DO ((G166922 |argl| (CDR G166922)) + (|x| NIL)) + ((OR (ATOM G166922) + (PROGN + (SETQ |x| (CAR G166922)) + NIL)) + (NREVERSE0 G166917)) + (SEQ (EXIT (SETQ G166917 + (CONS (|form2String1| |x|) + G166917))))))) + |u1|)) + ((BOOT-EQUAL |op| '|:|) + (COND + ((NULL |argl|) (CONS (MAKESTRING ":") NIL)) + ((NULL (CDR |argl|)) + (CONS (MAKESTRING ":") + (CONS (|form2String1| (CAR |argl|)) NIL))) + ('T + (|formDecl2String| (ELT |argl| 0) (ELT |argl| 1))))) + ((AND (BOOT-EQUAL |op| '|#|) (PAIRP |argl|) + (LISTP (CAR |argl|))) + (STRINGIMAGE (SIZE (CAR |argl|)))) + ((BOOT-EQUAL |op| '|Join|) (|formJoin2String| |argl|)) + ((BOOT-EQUAL |op| 'ATTRIBUTE) + (|form2String1| (CAR |argl|))) + ((BOOT-EQUAL |op| '|Zero|) 0) + ((BOOT-EQUAL |op| '|One|) 1) + ((BOOT-EQUAL |op| 'AGGLST) (|tuple2String| |argl|)) + ((BOOT-EQUAL |op| 'BRACKET) + (SPADLET |argl'| (|form2String1| (CAR |argl|))) + (CONS '[ + (APPEND (COND + ((ATOM |argl'|) (CONS |argl'| NIL)) + ('T |argl'|)) + (CONS '] NIL)))) + ((BOOT-EQUAL |op| 'SIGNATURE) + (SPADLET |operation| (CAR |argl|)) + (SPADLET |sig| (CADR |argl|)) + (|concat| |operation| '|: | (|formatSignature| |sig|))) + ((BOOT-EQUAL |op| 'COLLECT) + (|formCollect2String| |argl|)) + ((BOOT-EQUAL |op| '|construct|) + (|concat| (|lbrkSch|) + (|tuple2String| + (PROG (G166932) + (SPADLET G166932 NIL) + (RETURN + (DO ((G166937 |argl| (CDR G166937)) + (|x| NIL)) + ((OR (ATOM G166937) + (PROGN + (SETQ |x| (CAR G166937)) + NIL)) + (NREVERSE0 G166932)) + (SEQ (EXIT + (SETQ G166932 + (CONS (|form2String1| |x|) + G166932)))))))) + (|rbrkSch|))) + ((BOOT-EQUAL |op| 'SEGMENT) + (COND + ((NULL |argl|) (MAKESTRING "..")) + ('T (SPADLET |lo| (|form2String1| (CAR |argl|))) + (SPADLET |argl| (CDR |argl|)) + (COND + ((OR (NULL |argl|) (NULL (CAR |argl|))) + (CONS |lo| (CONS (MAKESTRING "..") NIL))) + ('T + (CONS |lo| + (CONS ".." + (CONS (|form2String1| (CAR |argl|)) + NIL)))))))) + ((|isBinaryInfix| |op|) + (|fortexp0| (CONS |op| |argl|))) + ('T + (|application2String| |op| + (PROG (G166947) + (SPADLET G166947 NIL) + (RETURN + (DO ((G166952 |argl| (CDR G166952)) + (|x| NIL)) + ((OR (ATOM G166952) + (PROGN + (SETQ |x| (CAR G166952)) + NIL)) + (NREVERSE0 G166947)) + (SEQ (EXIT (SETQ G166947 + (CONS (|form2String1| |x|) + G166947))))))) + |u1|))))))))) ;formWrapId id == ; $formatSigAsTeX = 1 => id @@ -1414,14 +1511,14 @@ ; error "Bad formatSigValue" (DEFUN |formWrapId| (|id|) - (PROG (|sep|) - (RETURN - (COND - ((EQL |$formatSigAsTeX| 1) |id|) - ((EQL |$formatSigAsTeX| 2) - (SPADLET |sep| (MAKESTRING "`")) - (FORMAT NIL (MAKESTRING "\\verb~a~a~a") |sep| |id| |sep|)) - ((QUOTE T) (|error| (QUOTE |Bad formatSigValue|))))))) + (PROG (|sep|) + (DECLARE (SPECIAL |$formatSigAsTeX|)) + (RETURN + (COND + ((EQL |$formatSigAsTeX| 1) |id|) + ((EQL |$formatSigAsTeX| 2) (SPADLET |sep| (MAKESTRING "`")) + (FORMAT NIL (MAKESTRING "\\verb~a~a~a") |sep| |id| |sep|)) + ('T (|error| '|Bad formatSigValue|)))))) ;formArguments2String(argl,ml) == [fn(x,m) for x in argl for m in ml] where ; fn(x,m) == @@ -1436,48 +1533,45 @@ ; form2String1 x (DEFUN |formArguments2String,fn| (|x| |m|) - (PROG (|x'|) - (RETURN - (SEQ - (IF (OR (BOOT-EQUAL |x| |$EmptyMode|) (BOOT-EQUAL |x| |$quadSymbol|)) - (EXIT (|specialChar| (QUOTE |quad|)))) - (IF (OR (STRINGP |x|) (IDENTP |x|)) (EXIT |x|)) - (IF (AND (PAIRP |x|) (EQUAL (QCAR |x|) (QUOTE |:|))) - (EXIT (|form2String1| |x|))) - (IF - (AND - (AND (|isValidType| |m|) (PAIRP |m|)) - (BOOT-EQUAL - (GETDATABASE (CAR |m|) (QUOTE CONSTRUCTORKIND)) - (QUOTE |domain|))) - (EXIT - (SEQ - (IF - (SPADLET |x'| - (|coerceInteractive| (|objNewWrap| |x| |m|) |$OutputForm|)) - (EXIT (|form2String1| (|objValUnwrap| |x'|)))) - (EXIT (|form2String1| |x|))))) - (EXIT (|form2String1| |x|)))))) + (PROG (|x'|) + (DECLARE (SPECIAL |$OutputForm| |$quadSymbol| |$EmptyMode|)) + (RETURN + (SEQ (IF (OR (BOOT-EQUAL |x| |$EmptyMode|) + (BOOT-EQUAL |x| |$quadSymbol|)) + (EXIT (|specialChar| '|quad|))) + (IF (OR (STRINGP |x|) (IDENTP |x|)) (EXIT |x|)) + (IF (AND (PAIRP |x|) (EQUAL (QCAR |x|) '|:|)) + (EXIT (|form2String1| |x|))) + (IF (AND (AND (|isValidType| |m|) (PAIRP |m|)) + (BOOT-EQUAL + (GETDATABASE (CAR |m|) 'CONSTRUCTORKIND) + '|domain|)) + (EXIT (SEQ (IF (SPADLET |x'| + (|coerceInteractive| + (|objNewWrap| |x| |m|) + |$OutputForm|)) + (EXIT (|form2String1| + (|objValUnwrap| |x'|)))) + (EXIT (|form2String1| |x|))))) + (EXIT (|form2String1| |x|)))))) (DEFUN |formArguments2String| (|argl| |ml|) - (PROG NIL - (RETURN - (SEQ - (PROG (#0=#:G166997) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G167003 |argl| (CDR #1#)) - (|x| NIL) - (#2=#:G167004 |ml| (CDR #2#)) - (|m| NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ |x| (CAR #1#)) NIL) - (ATOM #2#) - (PROGN (SETQ |m| (CAR #2#)) NIL)) - (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# (CONS (|formArguments2String,fn| |x| |m|) #0#))))))))))) + (PROG () + (RETURN + (SEQ (PROG (G166997) + (SPADLET G166997 NIL) + (RETURN + (DO ((G167003 |argl| (CDR G167003)) (|x| NIL) + (G167004 |ml| (CDR G167004)) (|m| NIL)) + ((OR (ATOM G167003) + (PROGN (SETQ |x| (CAR G167003)) NIL) + (ATOM G167004) + (PROGN (SETQ |m| (CAR G167004)) NIL)) + (NREVERSE0 G166997)) + (SEQ (EXIT (SETQ G166997 + (CONS (|formArguments2String,fn| |x| + |m|) + G166997))))))))))) ;formDecl2String(left,right) == ; $declVar: local := left @@ -1488,18 +1582,18 @@ ; concat(form2StringLocal ls,'": ",rs) (DEFUN |formDecl2String| (|left| |right|) - (PROG (|$declVar| |whereBefore| |ls| |rs|) - (DECLARE (SPECIAL |$declVar|)) - (RETURN - (PROGN - (SPADLET |$declVar| |left|) - (SPADLET |whereBefore| |$whereList|) - (SPADLET |ls| (|form2StringLocal| |left|)) - (SPADLET |rs| (|form2StringLocal| |right|)) - (COND - ((AND (NE |$whereList| |whereBefore|) |$permitWhere|) |ls|) - ((QUOTE T) - (|concat| (|form2StringLocal| |ls|) (MAKESTRING ": ") |rs|))))))) + (PROG (|$declVar| |whereBefore| |ls| |rs|) + (DECLARE (SPECIAL |$declVar| |$permitWhere| |$whereList|)) + (RETURN + (PROGN + (SPADLET |$declVar| |left|) + (SPADLET |whereBefore| |$whereList|) + (SPADLET |ls| (|form2StringLocal| |left|)) + (SPADLET |rs| (|form2StringLocal| |right|)) + (COND + ((AND (NE |$whereList| |whereBefore|) |$permitWhere|) |ls|) + ('T + (|concat| (|form2StringLocal| |ls|) (MAKESTRING ": ") |rs|))))))) ;formJoin1(op,u) == ; if op = 'Join then [:argl,last] := u else (argl := nil; last := [op,:u]) @@ -1516,62 +1610,42 @@ ; formJoin2 u (DEFUN |formJoin1| (|op| |u|) - (PROG (|LETTMP#1| |argl| |last| |id| |ISTMP#1| |r| |opList| |suffix|) - (RETURN - (PROGN - (COND - ((BOOT-EQUAL |op| (QUOTE |Join|)) - (SPADLET |LETTMP#1| (REVERSE |u|)) - (SPADLET |last| (CAR |LETTMP#1|)) - (SPADLET |argl| (NREVERSE (CDR |LETTMP#1|))) - |u|) - ((QUOTE T) - (SPADLET |argl| NIL) - (SPADLET |last| (CONS |op| |u|)))) - (COND - ((AND (PAIRP |last|) - (PROGN - (SPADLET |id| (QCAR |last|)) - (SPADLET |ISTMP#1| (QCDR |last|)) - (AND (PAIRP |ISTMP#1|) - (PROGN (SPADLET |r| (QCDR |ISTMP#1|)) (QUOTE T)))) - (|member| |id| (QUOTE (|mkCategory| CATEGORY)))) - (COND - ((BOOT-EQUAL |$abbreviateJoin| (QUOTE T)) - (|concat| - (|formJoin2| |argl|) - (QUOTE |%b|) - (MAKESTRING "with") - (QUOTE |%d|) - (MAKESTRING "..."))) - ((BOOT-EQUAL |$permitWhere| (QUOTE T)) - (SPADLET |opList| (|formatJoinKey| |r| |id|)) - (SPADLET |$whereList| - (|concat| - |$whereList| - (QUOTE |%l|) - |$declVar| - (QUOTE |: |) - (|formJoin2| |argl|) - (QUOTE |%b|) - (MAKESTRING "with") - (QUOTE |%d|) - (QUOTE |%i|) - |opList| - (QUOTE |%u|))) - (|formJoin2| |argl|)) - ((QUOTE T) - (SPADLET |opList| (|formatJoinKey| |r| |id|)) - (SPADLET |suffix| - (|concat| - (QUOTE |%b|) - (MAKESTRING "with") - (QUOTE |%d|) - (QUOTE |%i|) - |opList| - (QUOTE |%u|))) - (|concat| (|formJoin2| |argl|) |suffix|)))) - ((QUOTE T) (|formJoin2| |u|))))))) + (PROG (|LETTMP#1| |argl| |last| |id| |ISTMP#1| |r| |opList| |suffix|) + (DECLARE (SPECIAL |$declVar| |$whereList| |$permitWhere| + |$abbreviateJoin|)) + (RETURN + (PROGN + (COND + ((BOOT-EQUAL |op| '|Join|) (SPADLET |LETTMP#1| (REVERSE |u|)) + (SPADLET |last| (CAR |LETTMP#1|)) + (SPADLET |argl| (NREVERSE (CDR |LETTMP#1|))) |u|) + ('T (SPADLET |argl| NIL) (SPADLET |last| (CONS |op| |u|)))) + (COND + ((AND (PAIRP |last|) + (PROGN + (SPADLET |id| (QCAR |last|)) + (SPADLET |ISTMP#1| (QCDR |last|)) + (AND (PAIRP |ISTMP#1|) + (PROGN (SPADLET |r| (QCDR |ISTMP#1|)) 'T))) + (|member| |id| '(|mkCategory| CATEGORY))) + (COND + ((BOOT-EQUAL |$abbreviateJoin| 'T) + (|concat| (|formJoin2| |argl|) '|%b| (MAKESTRING "with") + '|%d| (MAKESTRING "..."))) + ((BOOT-EQUAL |$permitWhere| 'T) + (SPADLET |opList| (|formatJoinKey| |r| |id|)) + (SPADLET |$whereList| + (|concat| |$whereList| '|%l| |$declVar| '|: | + (|formJoin2| |argl|) '|%b| + (MAKESTRING "with") '|%d| '|%i| |opList| + '|%u|)) + (|formJoin2| |argl|)) + ('T (SPADLET |opList| (|formatJoinKey| |r| |id|)) + (SPADLET |suffix| + (|concat| '|%b| (MAKESTRING "with") '|%d| '|%i| + |opList| '|%u|)) + (|concat| (|formJoin2| |argl|) |suffix|)))) + ('T (|formJoin2| |u|))))))) ;formatJoinKey(r,key) == ; key = 'mkCategory => @@ -1595,115 +1669,147 @@ ; x (DEFUN |formatJoinKey| (|r| |key|) - (PROG (|opPart| |catPart| |opString| |u| |con| |pred| |catString| |op| - |ISTMP#2| |sig| |ISTMP#1| |a|) - (RETURN - (SEQ - (COND - ((BOOT-EQUAL |key| (QUOTE |mkCategory|)) - (COND - ((AND (PAIRP |r|) - (PROGN - (SPADLET |opPart| (QCAR |r|)) - (SPADLET |ISTMP#1| (QCDR |r|)) - (AND (PAIRP |ISTMP#1|) - (PROGN (SPADLET |catPart| (QCAR |ISTMP#1|)) (QUOTE T))))) - (SPADLET |opString| - (COND - ((AND (PAIRP |opPart|) - (EQUAL (QCAR |opPart|) (QUOTE LIST)) - (PROGN (SPADLET |u| (QCDR |opPart|)) (QUOTE T))) - (PROG (#0=#:G167117) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G167123 |u| (CDR #1#)) (#2=#:G167068 NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ #2# (CAR #1#)) NIL) - (PROGN - (PROGN - (COND ((EQUAL (QUOTE QUOTE) (CAR #2#)) (QUOTE QUOTE))) - (SPADLET |op| (CAAADR #2#)) - (SPADLET |sig| (CAR (CDAADR #2#))) - (SPADLET |pred| (CADADR #2#)) - #2#) - NIL)) - #0#) - (SEQ - (EXIT - (SETQ #0# - (APPEND - #0# - (|concat| - (QUOTE |%l|) - (|formatOpSignature| |op| |sig|) - (|formatIf| |pred|)))))))))) - ((QUOTE T) NIL))) - (SPADLET |catString| - (COND - ((AND (PAIRP |catPart|) - (EQUAL (QCAR |catPart|) (QUOTE LIST)) - (PROGN (SPADLET |u| (QCDR |catPart|)) (QUOTE T))) - (PROG (#3=#:G167130) - (SPADLET #3# NIL) - (RETURN - (DO ((#4=#:G167136 |u| (CDR #4#)) (#5=#:G167075 NIL)) - ((OR (ATOM #4#) - (PROGN (SETQ #5# (CAR #4#)) NIL) + (PROG (|opPart| |catPart| |opString| |u| |con| |pred| |catString| + |op| |ISTMP#2| |sig| |ISTMP#1| |a|) + (RETURN + (SEQ (COND + ((BOOT-EQUAL |key| '|mkCategory|) + (COND + ((AND (PAIRP |r|) (PROGN - (PROGN - (COND ((EQUAL (QUOTE QUOTE) (CAR #5#)) (QUOTE QUOTE))) - (SPADLET |con| (CAADR #5#)) - (SPADLET |pred| (CADADR #5#)) - #5#) - NIL)) - #3#) - (SEQ - (EXIT - (SETQ #3# - (APPEND #3# - (|concat| - (QUOTE |%l|) - (MAKESTRING " ") - (|form2StringLocal| |con|) - (|formatIf| |pred|)))))))))) - ((QUOTE T) NIL))) - (|concat| |opString| |catString|)) - ((QUOTE T) (MAKESTRING "?? unknown mkCategory format ??")))) - ((QUOTE T) - (PROG (#6=#:G167143) - (SPADLET #6# NIL) - (RETURN - (DO ((#7=#:G167159 |r| (CDR #7#)) (|x| NIL)) - ((OR (ATOM #7#) (PROGN (SETQ |x| (CAR #7#)) NIL)) #6#) - (SEQ - (EXIT - (SETQ #6# - (APPEND #6# - (COND - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE SIGNATURE)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |op| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |sig| (QCAR |ISTMP#2|)) - (QUOTE T))))))) - (|concat| (QUOTE |%l|) (|formatOpSignature| |op| |sig|))) - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE ATTRIBUTE)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (QUOTE T))))) - (|concat| (QUOTE |%l|) (|formatAttribute| |a|))) - ((QUOTE T) |x|))))))))))))))) + (SPADLET |opPart| (QCAR |r|)) + (SPADLET |ISTMP#1| (QCDR |r|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |catPart| (QCAR |ISTMP#1|)) + 'T)))) + (SPADLET |opString| + (COND + ((AND (PAIRP |opPart|) + (EQUAL (QCAR |opPart|) 'LIST) + (PROGN + (SPADLET |u| (QCDR |opPart|)) + 'T)) + (PROG (G167117) + (SPADLET G167117 NIL) + (RETURN + (DO ((G167123 |u| (CDR G167123)) + (G167068 NIL)) + ((OR (ATOM G167123) + (PROGN + (SETQ G167068 + (CAR G167123)) + NIL) + (PROGN + (PROGN + (COND + ((EQUAL 'QUOTE + (CAR G167068)) + 'QUOTE)) + (SPADLET |op| + (CAAADR G167068)) + (SPADLET |sig| + (CAR (CDAADR G167068))) + (SPADLET |pred| + (CADADR G167068)) + G167068) + NIL)) + G167117) + (SEQ + (EXIT + (SETQ G167117 + (APPEND G167117 + (|concat| '|%l| + (|formatOpSignature| |op| + |sig|) + (|formatIf| |pred|)))))))))) + ('T NIL))) + (SPADLET |catString| + (COND + ((AND (PAIRP |catPart|) + (EQUAL (QCAR |catPart|) 'LIST) + (PROGN + (SPADLET |u| (QCDR |catPart|)) + 'T)) + (PROG (G167130) + (SPADLET G167130 NIL) + (RETURN + (DO ((G167136 |u| (CDR G167136)) + (G167075 NIL)) + ((OR (ATOM G167136) + (PROGN + (SETQ G167075 + (CAR G167136)) + NIL) + (PROGN + (PROGN + (COND + ((EQUAL 'QUOTE + (CAR G167075)) + 'QUOTE)) + (SPADLET |con| + (CAADR G167075)) + (SPADLET |pred| + (CADADR G167075)) + G167075) + NIL)) + G167130) + (SEQ + (EXIT + (SETQ G167130 + (APPEND G167130 + (|concat| '|%l| (MAKESTRING " ") + (|form2StringLocal| |con|) + (|formatIf| |pred|)))))))))) + ('T NIL))) + (|concat| |opString| |catString|)) + ('T (MAKESTRING "?? unknown mkCategory format ??")))) + ('T + (PROG (G167143) + (SPADLET G167143 NIL) + (RETURN + (DO ((G167159 |r| (CDR G167159)) (|x| NIL)) + ((OR (ATOM G167159) + (PROGN (SETQ |x| (CAR G167159)) NIL)) + G167143) + (SEQ (EXIT (SETQ G167143 + (APPEND G167143 + (COND + ((AND (PAIRP |x|) + (EQ (QCAR |x|) 'SIGNATURE) + (PROGN + (SPADLET |ISTMP#1| + (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |op| + (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) + NIL) + (PROGN + (SPADLET |sig| + (QCAR |ISTMP#2|)) + 'T)))))) + (|concat| '|%l| + (|formatOpSignature| |op| + |sig|))) + ((AND (PAIRP |x|) + (EQ (QCAR |x|) 'ATTRIBUTE) + (PROGN + (SPADLET |ISTMP#1| + (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |a| + (QCAR |ISTMP#1|)) + 'T)))) + (|concat| '|%l| + (|formatAttribute| |a|))) + ('T |x|))))))))))))))) ;formJoin2 argl == ;-- argl is a list of categories NOT containing a "with" @@ -1712,22 +1818,25 @@ ; application2String('Join,[form2StringLocal x for x in argl], NIL) (DEFUN |formJoin2| (|argl|) - (PROG NIL - (RETURN - (SEQ - (COND - ((NULL |argl|) (MAKESTRING "")) - ((EQL 1 (|#| |argl|)) (|form2StringLocal| (ELT |argl| 0))) - ((QUOTE T) - (|application2String| - (QUOTE |Join|) - (PROG (#0=#:G167194) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G167199 |argl| (CDR #1#)) (|x| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) - (SEQ (EXIT (SETQ #0# (CONS (|form2StringLocal| |x|) #0#))))))) - NIL))))))) + (PROG () + (RETURN + (SEQ (COND + ((NULL |argl|) (MAKESTRING "")) + ((EQL 1 (|#| |argl|)) (|form2StringLocal| (ELT |argl| 0))) + ('T + (|application2String| '|Join| + (PROG (G167194) + (SPADLET G167194 NIL) + (RETURN + (DO ((G167199 |argl| (CDR G167199)) + (|x| NIL)) + ((OR (ATOM G167199) + (PROGN (SETQ |x| (CAR G167199)) NIL)) + (NREVERSE0 G167194)) + (SEQ (EXIT (SETQ G167194 + (CONS (|form2StringLocal| |x|) + G167194))))))) + NIL))))))) ;formJoin2String (u:=[:argl,last]) == ; last is ["CATEGORY",.,:atsigList] => @@ -1737,54 +1846,62 @@ ; application2String('Join,u, NIL) (DEFUN |formJoin2String| (|u|) - (PROG (|LETTMP#1| |last| |argl| |ISTMP#1| |atsigList| |postString|) - (RETURN - (PROGN - (SPADLET |LETTMP#1| (REVERSE |u|)) - (SPADLET |last| (CAR |LETTMP#1|)) - (SPADLET |argl| (NREVERSE (CDR |LETTMP#1|))) - (COND - ((AND (PAIRP |last|) - (EQ (QCAR |last|) (QUOTE CATEGORY)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |last|)) - (AND (PAIRP |ISTMP#1|) - (PROGN (SPADLET |atsigList| (QCDR |ISTMP#1|)) (QUOTE T))))) - (SPADLET |postString| - (|concat| (QUOTE |(|) (|formTuple2String| |atsigList|) (QUOTE |)|))) - (COND - ((EQL (|#| |argl|) 1) - (|concat| (CAR |argl|) (MAKESTRING " with ") |postString|)) - ((QUOTE T) - (|concat| - (|application2String| (QUOTE |Join|) |argl| NIL) - (QUOTE | with |) - |postString|)))) - ((QUOTE T) (|application2String| (QUOTE |Join|) |u| NIL))))))) + (PROG (|LETTMP#1| |last| |argl| |ISTMP#1| |atsigList| |postString|) + (RETURN + (PROGN + (SPADLET |LETTMP#1| (REVERSE |u|)) + (SPADLET |last| (CAR |LETTMP#1|)) + (SPADLET |argl| (NREVERSE (CDR |LETTMP#1|))) + (COND + ((AND (PAIRP |last|) (EQ (QCAR |last|) 'CATEGORY) + (PROGN + (SPADLET |ISTMP#1| (QCDR |last|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |atsigList| (QCDR |ISTMP#1|)) + 'T)))) + (SPADLET |postString| + (|concat| '|(| (|formTuple2String| |atsigList|) + '|)|)) + (COND + ((EQL (|#| |argl|) 1) + (|concat| (CAR |argl|) (MAKESTRING " with ") + |postString|)) + ('T + (|concat| (|application2String| '|Join| |argl| NIL) + '| with | |postString|)))) + ('T (|application2String| '|Join| |u| NIL))))))) ;formCollect2String [:itl,body] == ; ["_(",body,:"append"/[formIterator2String x for x in itl],"_)"] -(DEFUN |formCollect2String| (#0=#:G167238) - (PROG (|LETTMP#1| |body| |itl|) - (RETURN - (SEQ - (PROGN - (SPADLET |LETTMP#1| (REVERSE #0#)) - (SPADLET |body| (CAR |LETTMP#1|)) - (SPADLET |itl| (NREVERSE (CDR |LETTMP#1|))) - (CONS - (QUOTE |(|) - (CONS - |body| - (APPEND - (PROG (#1=#:G167249) - (SPADLET #1# NIL) - (RETURN - (DO ((#2=#:G167254 |itl| (CDR #2#)) (|x| NIL)) - ((OR (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #1#) - (SEQ (EXIT (SETQ #1# (APPEND #1# (|formIterator2String| |x|)))))))) - (CONS (QUOTE |)|) NIL))))))))) +(DEFUN |formCollect2String| (G167238) + (PROG (|LETTMP#1| |body| |itl|) + (RETURN + (SEQ (PROGN + (SPADLET |LETTMP#1| (REVERSE G167238)) + (SPADLET |body| (CAR |LETTMP#1|)) + (SPADLET |itl| (NREVERSE (CDR |LETTMP#1|))) + (CONS '|(| + (CONS |body| + (APPEND (PROG (G167249) + (SPADLET G167249 NIL) + (RETURN + (DO + ((G167254 |itl| + (CDR G167254)) + (|x| NIL)) + ((OR (ATOM G167254) + (PROGN + (SETQ |x| (CAR G167254)) + NIL)) + G167249) + (SEQ + (EXIT + (SETQ G167249 + (APPEND G167249 + (|formIterator2String| |x|)))))))) + (CONS '|)| NIL))))))))) ;formIterator2String x == ; x is ["STEP",y,s,.,:l] => @@ -1798,78 +1915,67 @@ ; systemErrorHere "formatIterator" (DEFUN |formIterator2String| (|x|) - (PROG (|s| |ISTMP#3| |l| |f| |tail| |y| |ISTMP#2| |ISTMP#1| |p|) - (RETURN - (COND - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE STEP)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |y| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |s| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND (PAIRP |ISTMP#3|) - (PROGN - (SPADLET |l| (QCDR |ISTMP#3|)) - (QUOTE T))))))))) - (SPADLET |tail| + (PROG (|s| |ISTMP#3| |l| |f| |tail| |y| |ISTMP#2| |ISTMP#1| |p|) + (RETURN (COND - ((AND (PAIRP |l|) - (EQ (QCDR |l|) NIL) - (PROGN (SPADLET |f| (QCAR |l|)) (QUOTE T))) - (|form2StringLocal| |f|)) - ((QUOTE T) NIL))) - (|concat| (QUOTE |for |) |y| (QUOTE | in |) |s| (MAKESTRING "..") |tail|)) - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE |tails|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T))))) - (|concat| (QUOTE |tails |) (|formatIterator| |y|))) - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE |reverse|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T))))) - (|concat| (QUOTE |reverse |) (|formatIterator| |y|))) - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE |\||)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |y| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |p| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (|concat| (|formatIterator| |y|) (QUOTE | \| |) (|form2StringLocal| |p|))) - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE |until|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) (QUOTE T))))) - (|concat| (QUOTE |until |) (|form2StringLocal| |p|))) - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE |while|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) (QUOTE T))))) - (|concat| (QUOTE |while |) (|form2StringLocal| |p|))) - ((QUOTE T) (|systemErrorHere| (QUOTE |formatIterator|))))))) + ((AND (PAIRP |x|) (EQ (QCAR |x|) 'STEP) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |y| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |s| (QCAR |ISTMP#2|)) + (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (PROGN + (SPADLET |l| (QCDR |ISTMP#3|)) + 'T)))))))) + (SPADLET |tail| + (COND + ((AND (PAIRP |l|) (EQ (QCDR |l|) NIL) + (PROGN (SPADLET |f| (QCAR |l|)) 'T)) + (|form2StringLocal| |f|)) + ('T NIL))) + (|concat| '|for | |y| '| in | |s| (MAKESTRING "..") |tail|)) + ((AND (PAIRP |x|) (EQ (QCAR |x|) '|tails|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) 'T)))) + (|concat| '|tails | (|formatIterator| |y|))) + ((AND (PAIRP |x|) (EQ (QCAR |x|) '|reverse|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) 'T)))) + (|concat| '|reverse | (|formatIterator| |y|))) + ((AND (PAIRP |x|) (EQ (QCAR |x|) '|\||) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |y| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (PROGN (SPADLET |p| (QCAR |ISTMP#2|)) 'T)))))) + (|concat| (|formatIterator| |y|) '| \| | + (|form2StringLocal| |p|))) + ((AND (PAIRP |x|) (EQ (QCAR |x|) '|until|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) 'T)))) + (|concat| '|until | (|form2StringLocal| |p|))) + ((AND (PAIRP |x|) (EQ (QCAR |x|) '|while|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) 'T)))) + (|concat| '|while | (|form2StringLocal| |p|))) + ('T (|systemErrorHere| '|formatIterator|)))))) ;tuple2String argl == ; null argl => nil @@ -1890,56 +1996,69 @@ ; string (DEFUN |tuple2String,f| (|x|) - (PROG NIL - (RETURN - (SEQ - (IF (ATOM |x|) (EXIT (|object2String| |x|))) - (EXIT - (PROG (#0=#:G167364) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G167369 |x| (CDR #1#)) (|y| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) (NREVERSE0 #0#)) - (SEQ (EXIT (SETQ #0# (CONS (|tuple2String,f| |y|) #0#)))))))))))) + (PROG () + (RETURN + (SEQ (IF (ATOM |x|) (EXIT (|object2String| |x|))) + (EXIT (PROG (G167364) + (SPADLET G167364 NIL) + (RETURN + (DO ((G167369 |x| (CDR G167369)) (|y| NIL)) + ((OR (ATOM G167369) + (PROGN (SETQ |y| (CAR G167369)) NIL)) + (NREVERSE0 G167364)) + (SEQ (EXIT (SETQ G167364 + (CONS (|tuple2String,f| |y|) + G167364)))))))))))) (DEFUN |tuple2String| (|argl|) - (PROG (|x| |string|) - (RETURN - (SEQ - (COND - ((NULL |argl|) NIL) - ((QUOTE T) - (SPADLET |string| (CAR |argl|)) - (COND - ((|member| |string| (QUOTE ("failed" "nil" "prime" "sqfr" "irred"))) - (SPADLET |string| (STRCONC "\"" |string| "\""))) - ((QUOTE T) - (SPADLET |string| - (COND - ((ATOM |string|) (|object2String| |string|)) - ((QUOTE T) - (PROG (#0=#:G167387) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G167392 |string| (CDR #1#)) (|x| NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ |x| (CAR #1#)) NIL)) - (NREVERSE0 #0#)) - (SEQ - (EXIT (SETQ #0# (CONS (|tuple2String,f| |x|) #0#)))))))))))) - (DO ((#2=#:G167403 (CDR |argl|) (CDR #2#)) (|x| NIL)) - ((OR (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (COND - ((|member| |x| (QUOTE ("failed" "nil" "prime" "sqfr" "irred"))) - (SPADLET |x| (STRCONC (MAKESTRING "\"") |x| (MAKESTRING "\""))))) - (SPADLET |string| - (|concat| - |string| - (|concat| (QUOTE |,|) (|tuple2String,f| |x|)))))))) - |string|)))))) + (PROG (|string|) + (RETURN + (SEQ (COND + ((NULL |argl|) NIL) + ('T (SPADLET |string| (CAR |argl|)) + (COND + ((|member| |string| + '("failed" "nil" "prime" "sqfr" "irred")) + (SPADLET |string| (STRCONC "\"" |string| "\""))) + ('T + (SPADLET |string| + (COND + ((ATOM |string|) + (|object2String| |string|)) + ('T + (PROG (G167387) + (SPADLET G167387 NIL) + (RETURN + (DO ((G167392 |string| + (CDR G167392)) + (|x| NIL)) + ((OR (ATOM G167392) + (PROGN + (SETQ |x| (CAR G167392)) + NIL)) + (NREVERSE0 G167387)) + (SEQ + (EXIT + (SETQ G167387 + (CONS (|tuple2String,f| |x|) + G167387)))))))))))) + (DO ((G167403 (CDR |argl|) (CDR G167403)) (|x| NIL)) + ((OR (ATOM G167403) + (PROGN (SETQ |x| (CAR G167403)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (COND + ((|member| |x| + '("failed" "nil" "prime" "sqfr" + "irred")) + (SPADLET |x| + (STRCONC (MAKESTRING "\"") |x| + (MAKESTRING "\""))))) + (SPADLET |string| + (|concat| |string| + (|concat| '|,| + (|tuple2String,f| |x|)))))))) + |string|)))))) ;script2String s == ; null s => '"" -- just to be safe @@ -1947,20 +2066,17 @@ ; linearFormatForm(CAR s, CDR s) (DEFUN |script2String| (|s|) - (COND - ((NULL |s|) (MAKESTRING "")) - ((QUOTE T) - (COND ((NULL (PAIRP |s|)) (SPADLET |s| (CONS |s| NIL)))) - (|linearFormatForm| (CAR |s|) (CDR |s|))))) + (COND + ((NULL |s|) (MAKESTRING "")) + ('T (COND ((NULL (PAIRP |s|)) (SPADLET |s| (CONS |s| NIL)))) + (|linearFormatForm| (CAR |s|) (CDR |s|))))) ;linearFormatName x == ; atom x => x ; linearFormat x (DEFUN |linearFormatName| (|x|) - (COND - ((ATOM |x|) |x|) - ((QUOTE T) (|linearFormat| |x|)))) + (COND ((ATOM |x|) |x|) ('T (|linearFormat| |x|)))) ;linearFormat x == ; atom x => x @@ -1972,42 +2088,54 @@ ; [linearFormat y for y in x] (DEFUN |linearFormat| (|x|) - (PROG (|op| |argl| |a| |l| |argPart|) - (RETURN - (SEQ - (COND - ((ATOM |x|) |x|) - ((AND (PAIRP |x|) - (PROGN - (SPADLET |op| (QCAR |x|)) - (SPADLET |argl| (QCDR |x|)) - (QUOTE T)) - (ATOM |op|)) - (SPADLET |argPart| - (COND - ((AND (PAIRP |argl|) - (PROGN - (SPADLET |a| (QCAR |argl|)) - (SPADLET |l| (QCDR |argl|)) - (QUOTE T))) - (CONS |a| - (PROG (#0=#:G167436) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G167441 |l| (CDR #1#)) (|x| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) #0#) - (SEQ - (EXIT - (SETQ #0# (APPEND #0# (CONS (QUOTE |,|) (CONS |x| NIL))))))))))) - ((QUOTE T) NIL))) - (CONS |op| (CONS (QUOTE |(|) (APPEND |argPart| (CONS (QUOTE |)|) NIL))))) - ((QUOTE T) - (PROG (#2=#:G167451) - (SPADLET #2# NIL) - (RETURN - (DO ((#3=#:G167456 |x| (CDR #3#)) (|y| NIL)) - ((OR (ATOM #3#) (PROGN (SETQ |y| (CAR #3#)) NIL)) (NREVERSE0 #2#)) - (SEQ (EXIT (SETQ #2# (CONS (|linearFormat| |y|) #2#))))))))))))) + (PROG (|op| |argl| |a| |l| |argPart|) + (RETURN + (SEQ (COND + ((ATOM |x|) |x|) + ((AND (PAIRP |x|) + (PROGN + (SPADLET |op| (QCAR |x|)) + (SPADLET |argl| (QCDR |x|)) + 'T) + (ATOM |op|)) + (SPADLET |argPart| + (COND + ((AND (PAIRP |argl|) + (PROGN + (SPADLET |a| (QCAR |argl|)) + (SPADLET |l| (QCDR |argl|)) + 'T)) + (CONS |a| + (PROG (G167436) + (SPADLET G167436 NIL) + (RETURN + (DO + ((G167441 |l| (CDR G167441)) + (|x| NIL)) + ((OR (ATOM G167441) + (PROGN + (SETQ |x| (CAR G167441)) + NIL)) + G167436) + (SEQ + (EXIT + (SETQ G167436 + (APPEND G167436 + (CONS '|,| (CONS |x| NIL))))))))))) + ('T NIL))) + (CONS |op| + (CONS '|(| (APPEND |argPart| (CONS '|)| NIL))))) + ('T + (PROG (G167451) + (SPADLET G167451 NIL) + (RETURN + (DO ((G167456 |x| (CDR G167456)) (|y| NIL)) + ((OR (ATOM G167456) + (PROGN (SETQ |y| (CAR G167456)) NIL)) + (NREVERSE0 G167451)) + (SEQ (EXIT (SETQ G167451 + (CONS (|linearFormat| |y|) + G167451))))))))))))) ;numOfSpadArguments id == ; char("*") = (s:= PNAME id).0 => @@ -2015,20 +2143,22 @@ ; keyedSystemError("S2IF0012",[id]) (DEFUN |numOfSpadArguments| (|id|) - (PROG (|s| |n|) - (RETURN - (SEQ - (COND - ((BOOT-EQUAL (|char| (QUOTE *)) (ELT (SPADLET |s| (PNAME |id|)) 0)) - (PROG (#0=#:G167473) - (SPADLET #0# 0) - (RETURN - (DO ((|i| 1 (QSADD1 |i|))) - ((NULL - (INTEGERP (SPADLET |n| (PARSE-INTEGER (PNAME (ELT |s| |i|)))))) - #0#) - (SEQ (EXIT (SETQ #0# (PLUS #0# |n|)))))))) - ((QUOTE T) (|keyedSystemError| (QUOTE S2IF0012) (CONS |id| NIL)))))))) + (PROG (|s| |n|) + (RETURN + (SEQ (COND + ((BOOT-EQUAL (|char| '*) + (ELT (SPADLET |s| (PNAME |id|)) 0)) + (PROG (G167473) + (SPADLET G167473 0) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((NULL (INTEGERP + (SPADLET |n| + (PARSE-INTEGER + (PNAME (ELT |s| |i|)))))) + G167473) + (SEQ (EXIT (SETQ G167473 (PLUS G167473 |n|)))))))) + ('T (|keyedSystemError| 'S2IF0012 (CONS |id| NIL)))))))) ;linearFormatForm(op,argl) == ; s:= PNAME op @@ -2054,79 +2184,100 @@ ; "STRCONC"/l (DEFUN |linearFormatForm| (|op| |argl|) - (PROG (|s| |maxIndex| |d| |indexList| |cleanOp| |fnArgs| |subArglist| - |scriptArgs| |l|) - (RETURN - (SEQ - (PROGN - (SPADLET |s| (PNAME |op|)) - (SPADLET |indexList| - (PROG (#0=#:G167500) - (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=#:G167509) - (SPADLET #1# "") - (RETURN - (DO ((#2=#:G167514 (MAXINDEX |s|)) (|i| |maxIndex| (+ |i| 1))) - ((> |i| #2#) #1#) - (SEQ (EXIT (SETQ #1# (STRCONC #1# (PNAME (ELT |s| |i|))))))))))) - (SPADLET |fnArgs| - (COND - ((> (ELT |indexList| 0) 0) - (|concat| - "(" - (|formatArgList| (TAKE (SPADDIFFERENCE (ELT |indexList| 0)) |argl|)) - ")")) - ((QUOTE T) NIL))) - (COND - ((> (|#| |indexList|) 1) - (SPADLET |scriptArgs| (|formatArgList| (TAKE (ELT |indexList| 1) |argl|))) - (SPADLET |argl| (DROP (ELT |indexList| 1) |argl|)) - (DO ((#3=#:G167524 (CDR (CDR |indexList|)) (CDR #3#)) (|i| NIL)) - ((OR (ATOM #3#) (PROGN (SETQ |i| (CAR #3#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |subArglist| (TAKE |i| |argl|)) - (SPADLET |argl| (DROP |i| |argl|)) - (SPADLET |scriptArgs| - (|concat| - |scriptArgs| - (QUOTE |;|) - (|formatArgList| |subArglist|))))))))) - (SPADLET |scriptArgs| - (COND - (|scriptArgs| - (|concat| - (|specialChar| (QUOTE |lbrk|)) - |scriptArgs| - (|specialChar| (QUOTE |rbrk|)))) - ((QUOTE T) NIL))) - (SPADLET |l| - (PROG (#4=#:G167534) - (SPADLET #4# NIL) - (RETURN - (DO ((#5=#:G167539 (|concat| |cleanOp| |scriptArgs| |fnArgs|) (CDR #5#)) - (|f| NIL)) - ((OR (ATOM #5#) (PROGN (SETQ |f| (CAR #5#)) NIL)) (NREVERSE0 #4#)) - (SEQ - (EXIT - (SETQ #4# - (CONS - (COND ((STRINGP |f|) |f|) ((QUOTE T) (STRINGIMAGE |f|))) - #4#)))))))) - (PROG (#6=#:G167545) - (SPADLET #6# "") - (RETURN - (DO ((#7=#:G167550 |l| (CDR #7#)) (#8=#:G167488 NIL)) - ((OR (ATOM #7#) (PROGN (SETQ #8# (CAR #7#)) NIL)) #6#) - (SEQ (EXIT (SETQ #6# (STRCONC #6# #8#)))))))))))) + (PROG (|s| |maxIndex| |d| |indexList| |cleanOp| |fnArgs| |subArglist| + |scriptArgs| |l|) + (RETURN + (SEQ (PROGN + (SPADLET |s| (PNAME |op|)) + (SPADLET |indexList| + (PROG (G167500) + (SPADLET G167500 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((NULL (DIGITP + (SPADLET |d| + (ELT |s| + (SPADLET |maxIndex| |i|))))) + (NREVERSE0 G167500)) + (SEQ (EXIT (SETQ G167500 + (CONS + (PARSE-INTEGER (PNAME |d|)) + G167500)))))))) + (SPADLET |cleanOp| + (INTERN (PROG (G167509) + (SPADLET G167509 "") + (RETURN + (DO ((G167514 (MAXINDEX |s|)) + (|i| |maxIndex| (+ |i| 1))) + ((> |i| G167514) G167509) + (SEQ + (EXIT + (SETQ G167509 + (STRCONC G167509 + (PNAME (ELT |s| |i|))))))))))) + (SPADLET |fnArgs| + (COND + ((> (ELT |indexList| 0) 0) + (|concat| "(" + (|formatArgList| + (TAKE (SPADDIFFERENCE + (ELT |indexList| 0)) + |argl|)) + ")")) + ('T NIL))) + (COND + ((> (|#| |indexList|) 1) + (SPADLET |scriptArgs| + (|formatArgList| + (TAKE (ELT |indexList| 1) |argl|))) + (SPADLET |argl| (DROP (ELT |indexList| 1) |argl|)) + (DO ((G167524 (CDR (CDR |indexList|)) + (CDR G167524)) + (|i| NIL)) + ((OR (ATOM G167524) + (PROGN (SETQ |i| (CAR G167524)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |subArglist| (TAKE |i| |argl|)) + (SPADLET |argl| (DROP |i| |argl|)) + (SPADLET |scriptArgs| + (|concat| |scriptArgs| '|;| + (|formatArgList| |subArglist|))))))))) + (SPADLET |scriptArgs| + (COND + (|scriptArgs| + (|concat| (|specialChar| '|lbrk|) + |scriptArgs| (|specialChar| '|rbrk|))) + ('T NIL))) + (SPADLET |l| + (PROG (G167534) + (SPADLET G167534 NIL) + (RETURN + (DO ((G167539 + (|concat| |cleanOp| |scriptArgs| + |fnArgs|) + (CDR G167539)) + (|f| NIL)) + ((OR (ATOM G167539) + (PROGN + (SETQ |f| (CAR G167539)) + NIL)) + (NREVERSE0 G167534)) + (SEQ (EXIT (SETQ G167534 + (CONS + (COND + ((STRINGP |f|) |f|) + ('T (STRINGIMAGE |f|))) + G167534)))))))) + (PROG (G167545) + (SPADLET G167545 "") + (RETURN + (DO ((G167550 |l| (CDR G167550)) (G167488 NIL)) + ((OR (ATOM G167550) + (PROGN (SETQ G167488 (CAR G167550)) NIL)) + G167545) + (SEQ (EXIT (SETQ G167545 + (STRCONC G167545 G167488)))))))))))) ;formatArgList l == ; null l => nil @@ -2136,19 +2287,19 @@ ; acc (DEFUN |formatArgList| (|l|) - (PROG (|acc|) - (RETURN - (SEQ - (COND - ((NULL |l|) NIL) - ((QUOTE T) - (SPADLET |acc| (|linearFormat| (CAR |l|))) - (DO ((#0=#:G167580 (CDR |l|) (CDR #0#)) (|x| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (SPADLET |acc| (|concat| |acc| (QUOTE |,|) (|linearFormat| |x|)))))) - |acc|)))))) + (PROG (|acc|) + (RETURN + (SEQ (COND + ((NULL |l|) NIL) + ('T (SPADLET |acc| (|linearFormat| (CAR |l|))) + (DO ((G167580 (CDR |l|) (CDR G167580)) (|x| NIL)) + ((OR (ATOM G167580) + (PROGN (SETQ |x| (CAR G167580)) NIL)) + NIL) + (SEQ (EXIT (SPADLET |acc| + (|concat| |acc| '|,| + (|linearFormat| |x|)))))) + |acc|)))))) ;formTuple2String argl == ; null argl => nil @@ -2158,22 +2309,20 @@ ; string (DEFUN |formTuple2String| (|argl|) - (PROG (|string|) - (RETURN - (SEQ - (COND - ((NULL |argl|) NIL) - ((QUOTE T) - (SPADLET |string| (|form2StringLocal| (CAR |argl|))) - (DO ((#0=#:G167595 (CDR |argl|) (CDR #0#)) (|x| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (SPADLET |string| - (|concat| - |string| - (|concat| (QUOTE |,|) (|form2StringLocal| |x|))))))) - |string|)))))) + (PROG (|string|) + (RETURN + (SEQ (COND + ((NULL |argl|) NIL) + ('T (SPADLET |string| (|form2StringLocal| (CAR |argl|))) + (DO ((G167595 (CDR |argl|) (CDR G167595)) (|x| NIL)) + ((OR (ATOM G167595) + (PROGN (SETQ |x| (CAR G167595)) NIL)) + NIL) + (SEQ (EXIT (SPADLET |string| + (|concat| |string| + (|concat| '|,| + (|form2StringLocal| |x|))))))) + |string|)))))) ;isInternalFunctionName(op) == ; (not IDENTP(op)) or (op = "*") or (op = "**") => NIL @@ -2188,26 +2337,26 @@ ; SUBSTRING(op',s,e-s) (DEFUN |isInternalFunctionName| (|op|) - (PROG (|op'| |e| |y| |table| |s|) - (RETURN - (COND - ((OR (NULL (IDENTP |op|)) - (BOOT-EQUAL |op| (QUOTE *)) - (BOOT-EQUAL |op| (QUOTE **))) - NIL) - ((OR (EQL 1 (SIZE (SPADLET |op'| (PNAME |op|)))) - (NEQUAL (|char| (QUOTE *)) (ELT |op'| 0))) - NIL) - ((NULL (SPADLET |e| (STRPOS (MAKESTRING ";") |op'| 1 NIL))) NIL) - ((OR (BOOT-EQUAL (|char| (QUOTE | |)) (SPADLET |y| (ELT |op'| 1))) - (BOOT-EQUAL (|char| (QUOTE *)) |y|)) - NIL) - ((QUOTE T) - (SPADLET |table| (MAKETRTTABLE (MAKESTRING "0123456789") NIL)) - (SPADLET |s| (STRPOSL |table| |op'| 1 (QUOTE T))) - (COND - ((OR (NULL |s|) (> |s| |e|)) NIL) - ((QUOTE T) (SUBSTRING |op'| |s| (SPADDIFFERENCE |e| |s|))))))))) + (PROG (|op'| |e| |y| |table| |s|) + (RETURN + (COND + ((OR (NULL (IDENTP |op|)) (BOOT-EQUAL |op| '*) + (BOOT-EQUAL |op| '**)) + NIL) + ((OR (EQL 1 (SIZE (SPADLET |op'| (PNAME |op|)))) + (NEQUAL (|char| '*) (ELT |op'| 0))) + NIL) + ((NULL (SPADLET |e| (STRPOS (MAKESTRING ";") |op'| 1 NIL))) + NIL) + ((OR (BOOT-EQUAL (|char| '| |) (SPADLET |y| (ELT |op'| 1))) + (BOOT-EQUAL (|char| '*) |y|)) + NIL) + ('T + (SPADLET |table| (MAKETRTTABLE (MAKESTRING "0123456789") NIL)) + (SPADLET |s| (STRPOSL |table| |op'| 1 'T)) + (COND + ((OR (NULL |s|) (> |s| |e|)) NIL) + ('T (SUBSTRING |op'| |s| (SPADDIFFERENCE |e| |s|))))))))) ;application2String(op,argl, linkInfo) == ; null argl => @@ -2231,39 +2380,33 @@ ; concat("_(",concat(tuple2String argl,"_)"))) (DEFUN |application2String| (|op| |argl| |linkInfo|) - (PROG (|op'| |ISTMP#1|) - (RETURN - (COND - ((NULL |argl|) - (COND - ((SPADLET |op'| (|isInternalFunctionName| |op|)) |op'|) - ((QUOTE T) (|app2StringWrap| (|formWrapId| |op|) |linkInfo|)))) - ((EQL 1 (|#| |argl|)) - (COND - ((PROGN - (SPADLET |ISTMP#1| (CAR |argl|)) - (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE <)))) - (|concat| |op| (CAR |argl|))) - ((QUOTE T) - (|concat| - (|app2StringWrap| (|formWrapId| |op|) |linkInfo|) - (QUOTE | |) - (CAR |argl|))))) - ((BOOT-EQUAL |op| (QUOTE SEGMENT)) - (COND - ((NULL |argl|) (MAKESTRING "..")) - ((OR (NULL (CDR |argl|)) (NULL (CAR (CDR |argl|)))) - (|concat| (CAR |argl|) (MAKESTRING ".."))) - ((QUOTE T) - (|concat| - (CAR |argl|) - (|concat| (MAKESTRING "..") (CAR (CDR |argl|))))))) - ((QUOTE T) - (|concat| - (|app2StringWrap| (|formWrapId| |op|) |linkInfo|) - (|concat| - (QUOTE |(|) - (|concat| (|tuple2String| |argl|) (QUOTE |)|))))))))) + (PROG (|op'| |ISTMP#1|) + (RETURN + (COND + ((NULL |argl|) + (COND + ((SPADLET |op'| (|isInternalFunctionName| |op|)) |op'|) + ('T (|app2StringWrap| (|formWrapId| |op|) |linkInfo|)))) + ((EQL 1 (|#| |argl|)) + (COND + ((PROGN + (SPADLET |ISTMP#1| (CAR |argl|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) '<))) + (|concat| |op| (CAR |argl|))) + ('T + (|concat| (|app2StringWrap| (|formWrapId| |op|) |linkInfo|) + '| | (CAR |argl|))))) + ((BOOT-EQUAL |op| 'SEGMENT) + (COND + ((NULL |argl|) (MAKESTRING "..")) + ((OR (NULL (CDR |argl|)) (NULL (CAR (CDR |argl|)))) + (|concat| (CAR |argl|) (MAKESTRING ".."))) + ('T + (|concat| (CAR |argl|) + (|concat| (MAKESTRING "..") (CAR (CDR |argl|))))))) + ('T + (|concat| (|app2StringWrap| (|formWrapId| |op|) |linkInfo|) + (|concat| '|(| (|concat| (|tuple2String| |argl|) '|)|)))))))) ;app2StringConcat0(x,y) == ; FORMAT(NIL, '"~a ~a", x, y) @@ -2281,35 +2424,39 @@ ; error "Bad value for $formatSigAsTeX" (DEFUN |app2StringWrap| (|string| |linkInfo|) - (PROG (|str2| |sep|) - (RETURN - (SEQ - (COND - ((NULL |linkInfo|) |string|) - ((EQL |$formatSigAsTeX| 1) |string|) - ((EQL |$formatSigAsTeX| 2) - (SPADLET |str2| - (PROG (#0=#:G167632 #1=#:G167633) - (SPADLET #0# (QUOTE #0#)) - (RETURN - (DO ((#2=#:G167640 (|form2Fence| |linkInfo|) (CDR #2#)) - (#3=#:G167629 NIL)) - ((OR (ATOM #2#) - (PROGN - (SETQ #3# (CAR #2#)) - NIL)) - (THETACHECK #0# (QUOTE #0#) (QUOTE |app2StringConcat0|))) - (SEQ - (EXIT - (PROGN - (SPADLET #1# #3#) - (SETQ #0# - (COND - ((EQ #0# (QUOTE #0#)) #1#) - ((QUOTE T) (|app2StringConcat0| #0# #1#))))))))))) - (SPADLET |sep| (MAKESTRING "`")) - (FORMAT NIL "\\lispLink{\\verb!(|conPage| '~a)!}{~a}" |str2| |string|)) - ((QUOTE T) (|error| (QUOTE |Bad value for $formatSigAsTeX|)))))))) + (PROG (|str2| |sep|) + (DECLARE (SPECIAL |$formatSigAsTeX|)) + (RETURN + (SEQ (COND + ((NULL |linkInfo|) |string|) + ((EQL |$formatSigAsTeX| 1) |string|) + ((EQL |$formatSigAsTeX| 2) + (SPADLET |str2| + (PROG (G167632 G167633) + (SPADLET G167632 'G167632) + (RETURN + (DO ((G167640 (|form2Fence| |linkInfo|) + (CDR G167640)) + (G167629 NIL)) + ((OR (ATOM G167640) + (PROGN + (SETQ G167629 (CAR G167640)) + NIL)) + (THETACHECK G167632 'G167632 + '|app2StringConcat0|)) + (SEQ (EXIT (PROGN + (SPADLET G167633 G167629) + (SETQ G167632 + (COND + ((EQ G167632 'G167632) + G167633) + ('T + (|app2StringConcat0| + G167632 G167633))))))))))) + (SPADLET |sep| (MAKESTRING "`")) + (FORMAT NIL "\\lispLink{\\verb!(|conPage| '~a)!}{~a}" + |str2| |string|)) + ('T (|error| '|Bad value for $formatSigAsTeX|))))))) ;record2String x == ; argPart := NIL @@ -2319,35 +2466,26 @@ ; concat("Record_(",rest argPart,"_)") (DEFUN |record2String| (|x|) - (PROG (|a| |b| |argPart|) - (RETURN - (SEQ - (PROGN - (SPADLET |argPart| NIL) - (DO ((#0=#:G167662 |x| (CDR #0#)) (#1=#:G167653 NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ #1# (CAR #0#)) NIL) - (PROGN - (PROGN - (SPADLET |a| (CADR #1#)) - (SPADLET |b| (CADDR #1#)) - #1#) - NIL)) - NIL) - (SEQ - (EXIT - (SPADLET |argPart| - (|concat| - |argPart| - (QUOTE |,|) - |a| - (QUOTE |: |) - (|form2StringLocal| |b|)))))) - (COND - ((NULL |argPart|) - (MAKESTRING "Record()")) - ((QUOTE T) - (|concat| (QUOTE |Record(|) (CDR |argPart|) (QUOTE |)|))))))))) + (PROG (|a| |b| |argPart|) + (RETURN + (SEQ (PROGN + (SPADLET |argPart| NIL) + (DO ((G167662 |x| (CDR G167662)) (G167653 NIL)) + ((OR (ATOM G167662) + (PROGN (SETQ G167653 (CAR G167662)) NIL) + (PROGN + (PROGN + (SPADLET |a| (CADR G167653)) + (SPADLET |b| (CADDR G167653)) + G167653) + NIL)) + NIL) + (SEQ (EXIT (SPADLET |argPart| + (|concat| |argPart| '|,| |a| '|: | + (|form2StringLocal| |b|)))))) + (COND + ((NULL |argPart|) (MAKESTRING "Record()")) + ('T (|concat| '|Record(| (CDR |argPart|) '|)|)))))))) ;plural(n,string) == ; suffix:= @@ -2356,11 +2494,11 @@ ; [:bright n,string,suffix] (DEFUN |plural| (|n| |string|) - (PROG (|suffix|) - (RETURN - (PROGN - (SPADLET |suffix| (COND ((EQL |n| 1) "") ((QUOTE T) "s"))) - (APPEND (|bright| |n|) (CONS |string| (CONS |suffix| NIL))))))) + (PROG (|suffix|) + (RETURN + (PROGN + (SPADLET |suffix| (COND ((EQL |n| 1) "") ('T "s"))) + (APPEND (|bright| |n|) (CONS |string| (CONS |suffix| NIL))))))) ;formatIf pred == ; not pred => nil @@ -2368,11 +2506,10 @@ ; concat('%b,'"if",'%d,pred2English pred) (DEFUN |formatIf| (|pred|) - (COND - ((NULL |pred|) NIL) - ((|member| |pred| (QUOTE (T (QUOTE T)))) NIL) - ((QUOTE T) - (|concat| (QUOTE |%b|) "if" (QUOTE |%d|) (|pred2English| |pred|))))) + (COND + ((NULL |pred|) NIL) + ((|member| |pred| '(T 'T)) NIL) + ('T (|concat| '|%b| "if" '|%d| (|pred2English| |pred|))))) ;formatPredParts s == ; s is ['QUOTE,s1] => formatPredParts s1 @@ -2386,91 +2523,96 @@ ; s (DEFUN |formatPredParts| (|s|) - (PROG (|a| |ISTMP#2| |b| |ISTMP#3| |c| |s1| |fun| |ISTMP#1| |sig|) - (RETURN - (SEQ - (COND - ((AND (PAIRP |s|) - (EQ (QCAR |s|) (QUOTE QUOTE)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |s|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |s1| (QCAR |ISTMP#1|)) (QUOTE T))))) - (|formatPredParts| |s1|)) - ((AND (PAIRP |s|) - (EQ (QCAR |s|) (QUOTE LIST)) - (PROGN (SPADLET |s1| (QCDR |s|)) (QUOTE T))) - (PROG (#0=#:G167753) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G167758 |s1| (CDR #1#)) (|s2| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |s2| (CAR #1#)) NIL)) (NREVERSE0 #0#)) - (SEQ (EXIT (SETQ #0# (CONS (|formatPredParts| |s2|) #0#)))))))) - ((AND (PAIRP |s|) - (EQ (QCAR |s|) (QUOTE |devaluate|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |s|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |s1| (QCAR |ISTMP#1|)) (QUOTE T))))) - (|formatPredParts| |s1|)) - ((AND (PAIRP |s|) - (EQ (QCAR |s|) (QUOTE |getDomainView|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |s|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |s1| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL)))))) - (|formatPredParts| |s1|)) - ((AND (PAIRP |s|) - (EQ (QCAR |s|) (QUOTE SUBST)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |s|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |a| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |b| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND (PAIRP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (PROGN - (SPADLET |c| (QCAR |ISTMP#3|)) - (QUOTE T))))))))) - (SPADLET |s1| - (|formatPredParts| (MSUBST (|formatPredParts| |a|) |b| |c|))) - (COND - ((NULL - (AND - (PAIRP |s1|) - (PROGN - (SPADLET |fun| (QCAR |s1|)) - (SPADLET |ISTMP#1| (QCDR |s1|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |sig| (QCAR |ISTMP#1|)) (QUOTE T)))))) - |s1|) - ((QUOTE T) - (CONS - (QUOTE SIGNATURE) - (CONS - |fun| - (CONS - (PROG (#2=#:G167768) - (SPADLET #2# NIL) - (RETURN - (DO ((#3=#:G167773 |sig| (CDR #3#)) (|r| NIL)) - ((OR (ATOM #3#) (PROGN (SETQ |r| (CAR #3#)) NIL)) - (NREVERSE0 #2#)) - (SEQ (EXIT (SETQ #2# (CONS (|formatPredParts| |r|) #2#))))))) - NIL)))))) - ((QUOTE T) |s|)))))) + (PROG (|a| |ISTMP#2| |b| |ISTMP#3| |c| |s1| |fun| |ISTMP#1| |sig|) + (RETURN + (SEQ (COND + ((AND (PAIRP |s|) (EQ (QCAR |s|) 'QUOTE) + (PROGN + (SPADLET |ISTMP#1| (QCDR |s|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |s1| (QCAR |ISTMP#1|)) 'T)))) + (|formatPredParts| |s1|)) + ((AND (PAIRP |s|) (EQ (QCAR |s|) 'LIST) + (PROGN (SPADLET |s1| (QCDR |s|)) 'T)) + (PROG (G167753) + (SPADLET G167753 NIL) + (RETURN + (DO ((G167758 |s1| (CDR G167758)) (|s2| NIL)) + ((OR (ATOM G167758) + (PROGN (SETQ |s2| (CAR G167758)) NIL)) + (NREVERSE0 G167753)) + (SEQ (EXIT (SETQ G167753 + (CONS (|formatPredParts| |s2|) + G167753)))))))) + ((AND (PAIRP |s|) (EQ (QCAR |s|) '|devaluate|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |s|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |s1| (QCAR |ISTMP#1|)) 'T)))) + (|formatPredParts| |s1|)) + ((AND (PAIRP |s|) (EQ (QCAR |s|) '|getDomainView|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |s|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |s1| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL)))))) + (|formatPredParts| |s1|)) + ((AND (PAIRP |s|) (EQ (QCAR |s|) 'SUBST) + (PROGN + (SPADLET |ISTMP#1| (QCDR |s|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |a| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |b| (QCAR |ISTMP#2|)) + (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQ (QCDR |ISTMP#3|) NIL) + (PROGN + (SPADLET |c| (QCAR |ISTMP#3|)) + 'T)))))))) + (SPADLET |s1| + (|formatPredParts| + (MSUBST (|formatPredParts| |a|) |b| |c|))) + (COND + ((NULL (AND (PAIRP |s1|) + (PROGN + (SPADLET |fun| (QCAR |s1|)) + (SPADLET |ISTMP#1| (QCDR |s1|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |sig| (QCAR |ISTMP#1|)) + 'T))))) + |s1|) + ('T + (CONS 'SIGNATURE + (CONS |fun| + (CONS (PROG (G167768) + (SPADLET G167768 NIL) + (RETURN + (DO + ((G167773 |sig| + (CDR G167773)) + (|r| NIL)) + ((OR (ATOM G167773) + (PROGN + (SETQ |r| (CAR G167773)) + NIL)) + (NREVERSE0 G167768)) + (SEQ + (EXIT + (SETQ G167768 + (CONS + (|formatPredParts| |r|) + G167768))))))) + NIL)))))) + ('T |s|)))))) ;pred2English x == ; x is ['IF,cond,thenClause,elseClause] => @@ -2505,166 +2647,170 @@ ; form2String x (DEFUN |pred2English| (|x|) - (PROG (|cond| |thenClause| |ISTMP#3| |elseClause| |c| |t| |e| |tail| |l| - |b'| |a| |ISTMP#2| |b| |op| |translation| |ISTMP#1| |form|) - (RETURN - (SEQ - (COND - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE IF)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |cond| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |thenClause| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) + (PROG (|cond| |thenClause| |ISTMP#3| |elseClause| |c| |t| |e| |tail| + |l| |b'| |a| |ISTMP#2| |b| |op| |translation| |ISTMP#1| + |form|) + (RETURN + (SEQ (COND + ((AND (PAIRP |x|) (EQ (QCAR |x|) 'IF) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) (PROGN - (SPADLET |elseClause| (QCAR |ISTMP#3|)) - (QUOTE T))))))))) - (SPADLET |c| (|concat| "if " (|pred2English| |cond|))) - (SPADLET |t| (|concat| " then " (|pred2English| |thenClause|))) - (SPADLET |e| (|concat| " else " (|pred2English| |elseClause|))) - (|concat| |c| |t| |e|)) - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE AND)) - (PROGN (SPADLET |l| (QCDR |x|)) (QUOTE T))) - (SPADLET |tail| - (PROG (#0=#:G167949) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G167954 (CDR |l|) (CDR #1#)) (|x| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) #0#) - (SEQ - (EXIT - (SETQ #0# - (APPEND #0# - (|concat| (|bright| "and") (|pred2English| |x|)))))))))) - (|concat| (|pred2English| (CAR |l|)) |tail|)) - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE OR)) - (PROGN (SPADLET |l| (QCDR |x|)) (QUOTE T))) - (SPADLET |tail| - (PROG (#2=#:G167960) - (SPADLET #2# NIL) - (RETURN - (DO ((#3=#:G167965 (CDR |l|) (CDR #3#)) (|x| NIL)) - ((OR (ATOM #3#) (PROGN (SETQ |x| (CAR #3#)) NIL)) #2#) - (SEQ - (EXIT - (SETQ #2# - (APPEND #2# - (|concat| (|bright| "or") (|pred2English| |x|)))))))))) - (|concat| (|pred2English| (CAR |l|)) |tail|)) - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE NOT)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |l| (QCAR |ISTMP#1|)) (QUOTE T))))) - (|concat| (MAKESTRING "not ") (|pred2English| |l|))) - ((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)))))) - (|member| |op| (QUOTE (|has| |ofCategory|)))) - (|concat| - (|pred2English| |a|) - (QUOTE |%b|) - (MAKESTRING "has") - (QUOTE |%d|) - (|form2String| (|abbreviate| |b|)))) - ((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)))))) - (|member| |op| - (QUOTE (|HasSignature| |HasAttribute| |HasCategory|)))) - (|concat| - (|prefix2String0| (|formatPredParts| |a|)) - (QUOTE |%b|) - (MAKESTRING "has") - (QUOTE |%d|) - (|prefix2String0| (|formatPredParts| |b|)))) - ((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)))))) - (|member| |op| (QUOTE (|ofType| |getDomainView|)))) - (COND - ((AND (PAIRP |b|) - (EQ (QCAR |b|) (QUOTE QUOTE)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |b|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |b'| (QCAR |ISTMP#1|)) (QUOTE T))))) - (SPADLET |b| |b'|))) - (|concat| - (|pred2English| |a|) - (MAKESTRING ": ") - (|form2String| (|abbreviate| |b|)))) - ((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)))))) - (|member| |op| (QUOTE (|isDomain| |domainEqual|)))) - (|concat| - (|pred2English| |a|) - (MAKESTRING " = ") - (|form2String| (|abbreviate| |b|)))) - ((AND (PAIRP |x|) - (PROGN (SPADLET |op| (QCAR |x|)) (QUOTE T)) - (SPADLET |translation| - (LASSOC |op| - (QUOTE ((< . " < ") (<= . " <= ") (> . " > ") (>= . " >= ") - (= . " = ") (^= . " ^= ")))))) - (|concat| (|pred2English| |a|) |translation| (|pred2English| |b|))) - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE ATTRIBUTE)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |form| (QCAR |ISTMP#1|)) (QUOTE T))))) - (|concat| (QUOTE |attribute: |) (|form2String| |form|))) - ((QUOTE T) (|form2String| |x|))))))) + (SPADLET |cond| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |thenClause| + (QCAR |ISTMP#2|)) + (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQ (QCDR |ISTMP#3|) NIL) + (PROGN + (SPADLET |elseClause| + (QCAR |ISTMP#3|)) + 'T)))))))) + (SPADLET |c| (|concat| "if " (|pred2English| |cond|))) + (SPADLET |t| + (|concat| " then " + (|pred2English| |thenClause|))) + (SPADLET |e| + (|concat| " else " + (|pred2English| |elseClause|))) + (|concat| |c| |t| |e|)) + ((AND (PAIRP |x|) (EQ (QCAR |x|) 'AND) + (PROGN (SPADLET |l| (QCDR |x|)) 'T)) + (SPADLET |tail| + (PROG (G167949) + (SPADLET G167949 NIL) + (RETURN + (DO ((G167954 (CDR |l|) (CDR G167954)) + (|x| NIL)) + ((OR (ATOM G167954) + (PROGN + (SETQ |x| (CAR G167954)) + NIL)) + G167949) + (SEQ (EXIT (SETQ G167949 + (APPEND G167949 + (|concat| (|bright| "and") + (|pred2English| |x|)))))))))) + (|concat| (|pred2English| (CAR |l|)) |tail|)) + ((AND (PAIRP |x|) (EQ (QCAR |x|) 'OR) + (PROGN (SPADLET |l| (QCDR |x|)) 'T)) + (SPADLET |tail| + (PROG (G167960) + (SPADLET G167960 NIL) + (RETURN + (DO ((G167965 (CDR |l|) (CDR G167965)) + (|x| NIL)) + ((OR (ATOM G167965) + (PROGN + (SETQ |x| (CAR G167965)) + NIL)) + G167960) + (SEQ (EXIT (SETQ G167960 + (APPEND G167960 + (|concat| (|bright| "or") + (|pred2English| |x|)))))))))) + (|concat| (|pred2English| (CAR |l|)) |tail|)) + ((AND (PAIRP |x|) (EQ (QCAR |x|) 'NOT) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |l| (QCAR |ISTMP#1|)) 'T)))) + (|concat| (MAKESTRING "not ") (|pred2English| |l|))) + ((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))))) + (|member| |op| '(|has| |ofCategory|))) + (|concat| (|pred2English| |a|) '|%b| (MAKESTRING "has") + '|%d| (|form2String| (|abbreviate| |b|)))) + ((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))))) + (|member| |op| + '(|HasSignature| |HasAttribute| |HasCategory|))) + (|concat| (|prefix2String0| (|formatPredParts| |a|)) + '|%b| (MAKESTRING "has") '|%d| + (|prefix2String0| (|formatPredParts| |b|)))) + ((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))))) + (|member| |op| '(|ofType| |getDomainView|))) + (COND + ((AND (PAIRP |b|) (EQ (QCAR |b|) 'QUOTE) + (PROGN + (SPADLET |ISTMP#1| (QCDR |b|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |b'| (QCAR |ISTMP#1|)) + 'T)))) + (SPADLET |b| |b'|))) + (|concat| (|pred2English| |a|) (MAKESTRING ": ") + (|form2String| (|abbreviate| |b|)))) + ((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))))) + (|member| |op| '(|isDomain| |domainEqual|))) + (|concat| (|pred2English| |a|) (MAKESTRING " = ") + (|form2String| (|abbreviate| |b|)))) + ((AND (PAIRP |x|) (PROGN (SPADLET |op| (QCAR |x|)) 'T) + (SPADLET |translation| + (LASSOC |op| + '((< . " < ") (<= . " <= ") + (> . " > ") (>= . " >= ") + (= . " = ") (^= . " ^= "))))) + (|concat| (|pred2English| |a|) |translation| + (|pred2English| |b|))) + ((AND (PAIRP |x|) (EQ (QCAR |x|) 'ATTRIBUTE) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |form| (QCAR |ISTMP#1|)) 'T)))) + (|concat| '|attribute: | (|form2String| |form|))) + ('T (|form2String| |x|))))))) ;object2String x == ; STRINGP x => x @@ -2674,13 +2820,13 @@ ; WRITE_-TO_-STRING x (DEFUN |object2String| (|x|) - (COND - ((STRINGP |x|) |x|) - ((IDENTP |x|) (PNAME |x|)) - ((NULL |x|) (MAKESTRING "")) - ((PAIRP |x|) - (STRCONC (|object2String| (CAR |x|)) (|object2String| (CDR |x|)))) - ((QUOTE T) (WRITE-TO-STRING |x|)))) + (COND + ((STRINGP |x|) |x|) + ((IDENTP |x|) (PNAME |x|)) + ((NULL |x|) (MAKESTRING "")) + ((PAIRP |x|) + (STRCONC (|object2String| (CAR |x|)) (|object2String| (CDR |x|)))) + ('T (WRITE-TO-STRING |x|)))) ;object2Identifier x == ; IDENTP x => x @@ -2688,23 +2834,26 @@ ; INTERN WRITE_-TO_-STRING x (DEFUN |object2Identifier| (|x|) - (COND - ((IDENTP |x|) |x|) - ((STRINGP |x|) (INTERN |x|)) - ((QUOTE T) (INTERN (WRITE-TO-STRING |x|))))) + (COND + ((IDENTP |x|) |x|) + ((STRINGP |x|) (INTERN |x|)) + ('T (INTERN (WRITE-TO-STRING |x|))))) ;blankList x == "append"/[[BLANK,y] for y in x] (DEFUN |blankList| (|x|) - (PROG NIL - (RETURN - (SEQ - (PROG (#0=#:G168026) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G168031 |x| (CDR #1#)) (|y| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) #0#) - (SEQ (EXIT (SETQ #0# (APPEND #0# (CONS BLANK (CONS |y| NIL))))))))))))) + (PROG () + (RETURN + (SEQ (PROG (G168026) + (SPADLET G168026 NIL) + (RETURN + (DO ((G168031 |x| (CDR G168031)) (|y| NIL)) + ((OR (ATOM G168031) + (PROGN (SETQ |y| (CAR G168031)) NIL)) + G168026) + (SEQ (EXIT (SETQ G168026 + (APPEND G168026 + (CONS BLANK (CONS |y| NIL))))))))))))) ;--------------------> NEW DEFINITION (see cformat.boot.pamphlet) ;pkey keyStuff == @@ -2726,38 +2875,39 @@ ; allMsgs (DEFUN |pkey| (|keyStuff|) - (PROG (|key| |dbN| |argL| |next| |oneMsg| |allMsgs|) - (RETURN - (SEQ - (PROGN - (COND - ((NULL (PAIRP |keyStuff|)) (SPADLET |keyStuff| (CONS |keyStuff| NIL)))) - (SPADLET |allMsgs| (CONS (MAKESTRING " ") NIL)) - (DO () - ((NULL (NULL (NULL |keyStuff|))) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |dbN| NIL) - (SPADLET |argL| NIL) - (SPADLET |key| (CAR |keyStuff|)) - (SPADLET |keyStuff| (IFCDR |keyStuff|)) - (SPADLET |next| (IFCAR |keyStuff|)) - (DO () - ((NULL (PAIRP |next|)) NIL) - (SEQ - (EXIT - (PROGN + (PROG (|key| |dbN| |argL| |next| |oneMsg| |allMsgs|) + (RETURN + (SEQ (PROGN (COND - ((BOOT-EQUAL (CAR |next|) (QUOTE |dbN|)) - (SPADLET |dbN| (CADR |next|))) - ((QUOTE T) - (SPADLET |argL| |next|))) - (SPADLET |keyStuff| (IFCDR |keyStuff|)) - (SPADLET |next| (IFCAR |keyStuff|)))))) - (SPADLET |oneMsg| (|returnStLFromKey| |key| |argL| |dbN|)) - (SPADLET |allMsgs| (CONS " " (NCONC |oneMsg| |allMsgs|))))))) - |allMsgs|))))) + ((NULL (PAIRP |keyStuff|)) + (SPADLET |keyStuff| (CONS |keyStuff| NIL)))) + (SPADLET |allMsgs| (CONS (MAKESTRING " ") NIL)) + (DO () ((NULL (NULL (NULL |keyStuff|))) NIL) + (SEQ (EXIT (PROGN + (SPADLET |dbN| NIL) + (SPADLET |argL| NIL) + (SPADLET |key| (CAR |keyStuff|)) + (SPADLET |keyStuff| (IFCDR |keyStuff|)) + (SPADLET |next| (IFCAR |keyStuff|)) + (DO () ((NULL (PAIRP |next|)) NIL) + (SEQ (EXIT + (PROGN + (COND + ((BOOT-EQUAL (CAR |next|) + '|dbN|) + (SPADLET |dbN| (CADR |next|))) + ('T (SPADLET |argL| |next|))) + (SPADLET |keyStuff| + (IFCDR |keyStuff|)) + (SPADLET |next| + (IFCAR |keyStuff|)))))) + (SPADLET |oneMsg| + (|returnStLFromKey| |key| |argL| + |dbN|)) + (SPADLET |allMsgs| + (CONS " " + (NCONC |oneMsg| |allMsgs|))))))) + |allMsgs|))))) ;string2Float s == ; -- takes a string, calls the parser on it and returns a float object @@ -2769,50 +2919,54 @@ ; SPADCALL(x, y, z, flt) (DEFUN |string2Float| (|s|) - (PROG (|p| |ISTMP#1| |ISTMP#2| |FloatDomain| |ISTMP#3| |ISTMP#4| |x| - |ISTMP#5| |y| |ISTMP#6| |z| |flt|) - (RETURN - (PROGN - (SPADLET |p| (|ncParseFromString| |s|)) - (COND - ((NULL - (AND (PAIRP |p|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |p|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) (QUOTE |$elt|)) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |FloatDomain| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND (PAIRP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (EQ (QCAR |ISTMP#3|) (QUOTE |float|)))))))) - (PROGN - (SPADLET |ISTMP#4| (QCDR |p|)) - (AND (PAIRP |ISTMP#4|) - (PROGN - (SPADLET |x| (QCAR |ISTMP#4|)) - (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) - (AND (PAIRP |ISTMP#5|) - (PROGN - (SPADLET |y| (QCAR |ISTMP#5|)) - (SPADLET |ISTMP#6| (QCDR |ISTMP#5|)) - (AND (PAIRP |ISTMP#6|) - (EQ (QCDR |ISTMP#6|) NIL) - (PROGN - (SPADLET |z| (QCAR |ISTMP#6|)) - (QUOTE T)))))))))) - (|systemError| "string2Float: did not get a float expression")) - ((QUOTE T) - (SPADLET |flt| - (|getFunctionFromDomain| - (QUOTE |float|) - |FloatDomain| - (CONS |$Integer| (CONS |$Integer| (CONS |$PositiveInteger| NIL))))) - (SPADCALL |x| |y| |z| |flt|))))))) + (PROG (|p| |ISTMP#1| |ISTMP#2| |FloatDomain| |ISTMP#3| |ISTMP#4| |x| + |ISTMP#5| |y| |ISTMP#6| |z| |flt|) + (DECLARE (SPECIAL |$PositiveInteger| |$Integer| |$elt|)) + (RETURN + (PROGN + (SPADLET |p| (|ncParseFromString| |s|)) + (COND + ((NULL (AND (PAIRP |p|) + (PROGN + (SPADLET |ISTMP#1| (QCAR |p|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCAR |ISTMP#1|) '|$elt|) + (PROGN + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |FloatDomain| + (QCAR |ISTMP#2|)) + (SPADLET |ISTMP#3| + (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQ (QCDR |ISTMP#3|) NIL) + (EQ (QCAR |ISTMP#3|) '|float|))))))) + (PROGN + (SPADLET |ISTMP#4| (QCDR |p|)) + (AND (PAIRP |ISTMP#4|) + (PROGN + (SPADLET |x| (QCAR |ISTMP#4|)) + (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) + (AND (PAIRP |ISTMP#5|) + (PROGN + (SPADLET |y| (QCAR |ISTMP#5|)) + (SPADLET |ISTMP#6| + (QCDR |ISTMP#5|)) + (AND (PAIRP |ISTMP#6|) + (EQ (QCDR |ISTMP#6|) NIL) + (PROGN + (SPADLET |z| (QCAR |ISTMP#6|)) + 'T))))))))) + (|systemError| + "string2Float: did not get a float expression")) + ('T + (SPADLET |flt| + (|getFunctionFromDomain| '|float| |FloatDomain| + (CONS |$Integer| + (CONS |$Integer| + (CONS |$PositiveInteger| NIL))))) + (SPADCALL |x| |y| |z| |flt|))))))) ;form2Fence form == ; -- body of dbMkEvalable @@ -2822,14 +2976,14 @@ ; form2Fence1 mkEvalable form (DEFUN |form2Fence| (|form|) - (PROG (|op| |kind|) - (RETURN - (PROGN - (SPADLET |op| (CAR |form|)) - (SPADLET |kind| (GETDATABASE |op| (QUOTE CONSTRUCTORKIND))) - (COND - ((BOOT-EQUAL |kind| (QUOTE |category|)) (|form2Fence1| |form|)) - ((QUOTE T) (|form2Fence1| (|mkEvalable| |form|)))))))) + (PROG (|op| |kind|) + (RETURN + (PROGN + (SPADLET |op| (CAR |form|)) + (SPADLET |kind| (GETDATABASE |op| 'CONSTRUCTORKIND)) + (COND + ((BOOT-EQUAL |kind| '|category|) (|form2Fence1| |form|)) + ('T (|form2Fence1| (|mkEvalable| |form|)))))))) ;form2Fence1 x == ; x is [op,:argl] => @@ -2840,38 +2994,44 @@ ; ['" ", x] (DEFUN |form2Fence1| (|x|) - (PROG (|op| |argl|) - (RETURN - (SEQ - (COND - ((AND (PAIRP |x|) - (PROGN - (SPADLET |op| (QCAR |x|)) - (SPADLET |argl| (QCDR |x|)) - (QUOTE T))) - (COND - ((BOOT-EQUAL |op| (QUOTE QUOTE)) - (CONS - (MAKESTRING "(QUOTE ") - (APPEND - (|form2FenceQuote| (CAR |argl|)) - (CONS (MAKESTRING ")") NIL)))) - ((QUOTE T) - (CONS - (MAKESTRING "(") - (CONS - (FORMAT NIL (MAKESTRING "|~a|") |op|) - (APPEND - (PROG (#0=#:G168166) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G168171 |argl| (CDR #1#)) (|y| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) #0#) - (SEQ (EXIT (SETQ #0# (APPEND #0# (|form2Fence1| |y|)))))))) - (CONS (MAKESTRING ")") NIL))))))) - ((IDENTP |x|) (FORMAT NIL (MAKESTRING "|~a|") |x|)) - ((QUOTE T) (CONS (MAKESTRING " ") (CONS |x| NIL)))))))) - + (PROG (|op| |argl|) + (RETURN + (SEQ (COND + ((AND (PAIRP |x|) + (PROGN + (SPADLET |op| (QCAR |x|)) + (SPADLET |argl| (QCDR |x|)) + 'T)) + (COND + ((BOOT-EQUAL |op| 'QUOTE) + (CONS (MAKESTRING "(QUOTE ") + (APPEND (|form2FenceQuote| (CAR |argl|)) + (CONS (MAKESTRING ")") NIL)))) + ('T + (CONS (MAKESTRING "(") + (CONS (FORMAT NIL (MAKESTRING "|~a|") |op|) + (APPEND (PROG (G168166) + (SPADLET G168166 NIL) + (RETURN + (DO + ((G168171 |argl| + (CDR G168171)) + (|y| NIL)) + ((OR (ATOM G168171) + (PROGN + (SETQ |y| + (CAR G168171)) + NIL)) + G168166) + (SEQ + (EXIT + (SETQ G168166 + (APPEND G168166 + (|form2Fence1| |y|)))))))) + (CONS (MAKESTRING ")") NIL))))))) + ((IDENTP |x|) (FORMAT NIL (MAKESTRING "|~a|") |x|)) + ('T (CONS (MAKESTRING " ") (CONS |x| NIL)))))))) + ;form2FenceQuote x == ; NUMBERP x => [STRINGIMAGE x] ; SYMBOLP x => [FORMAT(NIL, '"|~a|", x)] @@ -2879,16 +3039,14 @@ ; ['"(",:form2FenceQuote first x,:form2FenceQuoteTail rest x] (DEFUN |form2FenceQuote| (|x|) - (COND - ((NUMBERP |x|) (CONS (STRINGIMAGE |x|) NIL)) - ((SYMBOLP |x|) (CONS (FORMAT NIL (MAKESTRING "|~a|") |x|) NIL)) - ((ATOM |x|) (MAKESTRING "??")) - ((QUOTE T) - (CONS - (MAKESTRING "(") - (APPEND - (|form2FenceQuote| (CAR |x|)) - (|form2FenceQuoteTail| (CDR |x|))))))) + (COND + ((NUMBERP |x|) (CONS (STRINGIMAGE |x|) NIL)) + ((SYMBOLP |x|) (CONS (FORMAT NIL (MAKESTRING "|~a|") |x|) NIL)) + ((ATOM |x|) (MAKESTRING "??")) + ('T + (CONS (MAKESTRING "(") + (APPEND (|form2FenceQuote| (CAR |x|)) + (|form2FenceQuoteTail| (CDR |x|))))))) ;form2FenceQuoteTail x == ; null x => ['")"] @@ -2896,29 +3054,26 @@ ; ['" ",:form2FenceQuote first x,:form2FenceQuoteTail rest x] (DEFUN |form2FenceQuoteTail| (|x|) - (COND - ((NULL |x|) (CONS (MAKESTRING ")") NIL)) - ((ATOM |x|) - (CONS - (MAKESTRING " . ") - (APPEND (|form2FenceQuote| |x|) (CONS (MAKESTRING ")") NIL)))) - ((QUOTE T) - (CONS - (MAKESTRING " ") - (APPEND - (|form2FenceQuote| (CAR |x|)) - (|form2FenceQuoteTail| (CDR |x|))))))) + (COND + ((NULL |x|) (CONS (MAKESTRING ")") NIL)) + ((ATOM |x|) + (CONS (MAKESTRING " . ") + (APPEND (|form2FenceQuote| |x|) (CONS (MAKESTRING ")") NIL)))) + ('T + (CONS (MAKESTRING " ") + (APPEND (|form2FenceQuote| (CAR |x|)) + (|form2FenceQuoteTail| (CDR |x|))))))) ;form2StringList u == ; atom (r := form2String u) => [r] ; r (DEFUN |form2StringList| (|u|) - (PROG (|r|) - (RETURN - (COND - ((ATOM (SPADLET |r| (|form2String| |u|))) (CONS |r| NIL)) - ((QUOTE T) |r|))))) + (PROG (|r|) + (RETURN + (COND + ((ATOM (SPADLET |r| (|form2String| |u|))) (CONS |r| NIL)) + ('T |r|))))) @ \eject