diff --git a/changelog b/changelog index 2c2408f..f21602e 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +20090915 tpd src/axiom-website/patches.html 20090915.02.tpd.patch +20090915 tpd src/interp/buildom.lisp cleanup 20090915 tpd src/axiom-website/patches.html 20090915.01.tpd.patch 20090915 tpd src/interp/i-funsel.lisp refactored 20090914 tpd src/interp/Makefile add generic rules for lisp compiles diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index c1175c3..1574a5e 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2006,5 +2006,7 @@ src/input/unit-i-funsel.input unit test the i-funsel functions
src/interp/Makefile add generic rules for lisp compiles
20090915.01.tpd.patch src/interp/i-funsel.lisp refactored
+20090915.02.tpd.patch +src/interp/buildom.lisp cleanup
diff --git a/src/interp/buildom.lisp.pamphlet b/src/interp/buildom.lisp.pamphlet index 7d94cb2..3a7ad0c 100644 --- a/src/interp/buildom.lisp.pamphlet +++ b/src/interp/buildom.lisp.pamphlet @@ -14,12 +14,13 @@ ;SETANDFILEQ($noCategoryDomains, '(Domain Mode SubDomain)) -(SETANDFILEQ |$noCategoryDomains| (QUOTE (|Domain| |Mode| |SubDomain|))) +(SETANDFILEQ |$noCategoryDomains| '(|Domain| |Mode| |SubDomain|)) ;SETANDFILEQ($nonLisplibDomains, ; APPEND($Primitives,$noCategoryDomains)) -(SETANDFILEQ |$nonLisplibDomains| (APPEND |$Primitives| |$noCategoryDomains|)) +(SETANDFILEQ |$nonLisplibDomains| + (APPEND |$Primitives| |$noCategoryDomains|)) ;--% Record ;-- Want to eventually have the elts and setelts. @@ -28,7 +29,7 @@ ;isRecord type == type is ['Record,:.] (DEFUN |isRecord| (|type|) - (AND (PAIRP |type|) (EQ (QCAR |type|) (QUOTE |Record|)))) + (AND (PAIRP |type|) (EQ (QCAR |type|) '|Record|))) ;RecordInner args == ; -- this is old and should be removed wherever it occurs @@ -37,12 +38,13 @@ ; Record0 VEC2LIST args (DEFUN |RecordInner| (|args|) - (PROGN - (COND - (|$evalDomain| - (|sayBrightly| - (MAKESTRING "-->> Whoops! RecordInner called from this code.")))) - (|Record0| (VEC2LIST |args|)))) + (declare (special |$evalDomain|)) + (PROGN + (COND + (|$evalDomain| + (|sayBrightly| + "-->> Whoops! RecordInner called from this code."))) + (|Record0| (VEC2LIST |args|)))) ;Record0 args == ; dom := GETREFV 10 @@ -67,80 +69,81 @@ ; dom (DEFUN |Record0| (|args|) - (PROG (|dom| |n|) - (RETURN - (SEQ - (PROGN - (SPADLET |dom| (GETREFV 10)) - (SETELT |dom| 0 - (CONS - (QUOTE |Record|) - (PROG (#0=#:G166069) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166074 |args| (CDR #1#)) (|a| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |a| (CAR #1#)) NIL)) (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS - (CONS - (QUOTE |:|) - (CONS - (CAR |a|) - (CONS - (|devaluate| (CDR |a|)) - NIL))) - #0#))))))))) - (SETELT |dom| 1 - (CONS - (|function| |lookupInTable|) - (CONS - |dom| - (CONS - (CONS - (CONS - (QUOTE =) - (CONS - (CONS - (CONS - (CONS (QUOTE |Boolean|) NIL) - (CONS (QUOTE $) (CONS (QUOTE $) NIL))) - 12) - NIL)) - (CONS - (CONS - (QUOTE |coerce|) - (CONS - (CONS - (CONS - |$Expression| - (CONS (QUOTE $) NIL)) - 14) - NIL)) - NIL)) - NIL)))) - (SETELT |dom| 2 NIL) - (SETELT |dom| 3 (CONS (QUOTE |RecordCategory|) (QCDR (ELT |dom| 0)))) - (SETELT |dom| 4 - (CONS - (CONS (QUOTE (|SetCategory|)) NIL) - (CONS (CONS (QUOTE (|SetCategory|)) NIL) NIL))) - (SETELT |dom| 5 - (PROG (#2=#:G166084) - (SPADLET #2# NIL) - (RETURN - (DO ((#3=#:G166089 |args| (CDR #3#)) (|a| NIL)) - ((OR (ATOM #3#) (PROGN (SETQ |a| (CAR #3#)) NIL)) (NREVERSE0 #2#)) - (SEQ (EXIT (SETQ #2# (CONS (CDR |a|) #2#)))))))) - (SETELT |dom| 6 (CONS (|function| |RecordEqual|) |dom|)) - (SETELT |dom| 7 (CONS (|function| |RecordPrint|) |dom|)) - (SETELT |dom| 8 (CONS (|function| |Undef|) |dom|)) - (SETELT |dom| 9 - (COND - ((<= (SPADLET |n| (LENGTH |args|)) 2) (CONS NIL NIL)) - ((QUOTE T) (GETREFV |n|)))) - |dom|))))) + (PROG (|dom| |n|) + (declare (special |$Expression|)) + (RETURN + (SEQ (PROGN + (SPADLET |dom| (GETREFV 10)) + (SETELT |dom| 0 + (CONS '|Record| + (PROG (G166069) + (SPADLET G166069 NIL) + (RETURN + (DO ((G166074 |args| (CDR G166074)) + (|a| NIL)) + ((OR (ATOM G166074) + (PROGN + (SETQ |a| (CAR G166074)) + NIL)) + (NREVERSE0 G166069)) + (SEQ (EXIT + (SETQ G166069 + (CONS + (CONS '|:| + (CONS (CAR |a|) + (CONS + (|devaluate| (CDR |a|)) + NIL))) + G166069))))))))) + (SETELT |dom| 1 + (CONS (|function| |lookupInTable|) + (CONS |dom| + (CONS (CONS + (CONS '= + (CONS + (CONS + (CONS (CONS '|Boolean| NIL) + (CONS '$ (CONS '$ NIL))) + 12) + NIL)) + (CONS + (CONS '|coerce| + (CONS + (CONS + (CONS |$Expression| + (CONS '$ NIL)) + 14) + NIL)) + NIL)) + NIL)))) + (SETELT |dom| 2 NIL) + (SETELT |dom| 3 + (CONS '|RecordCategory| (QCDR (ELT |dom| 0)))) + (SETELT |dom| 4 + (CONS (CONS '(|SetCategory|) NIL) + (CONS (CONS '(|SetCategory|) NIL) NIL))) + (SETELT |dom| 5 + (PROG (G166084) + (SPADLET G166084 NIL) + (RETURN + (DO ((G166089 |args| (CDR G166089)) + (|a| NIL)) + ((OR (ATOM G166089) + (PROGN + (SETQ |a| (CAR G166089)) + NIL)) + (NREVERSE0 G166084)) + (SEQ (EXIT (SETQ G166084 + (CONS (CDR |a|) G166084)))))))) + (SETELT |dom| 6 (CONS (|function| |RecordEqual|) |dom|)) + (SETELT |dom| 7 (CONS (|function| |RecordPrint|) |dom|)) + (SETELT |dom| 8 (CONS (|function| |Undef|) |dom|)) + (SETELT |dom| 9 + (COND + ((<= (SPADLET |n| (LENGTH |args|)) 2) + (CONS NIL NIL)) + ('T (GETREFV |n|)))) + |dom|))))) ;RecordEqual(x,y,dom) == ; PAIRP x => @@ -158,61 +161,65 @@ ; error '"Bug: Silly record representation" (DEFUN |RecordEqual| (|x| |y| |dom|) - (PROG (|b| |equalfuns|) - (RETURN - (SEQ - (COND - ((PAIRP |x|) - (SPADLET |b| - (SPADCALL (CAR |x|) (CAR |y|) - (OR (CAR (ELT |dom| 9)) - (CAR - (RPLACA (ELT |dom| 9) (|findEqualFun| (ELT (ELT |dom| 5) 0))))))) - (COND - ((NULL (CDR (ELT |dom| 5))) |b|) - ((QUOTE T) - (AND |b| - (SPADCALL (CDR |x|) (CDR |y|) - (OR - (CDR (ELT |dom| 9)) - (CDR - (RPLACD - (ELT |dom| 9) - (|findEqualFun| (ELT (ELT |dom| 5) 1)))))))))) - ((VECP |x|) - (SPADLET |equalfuns| (ELT |dom| 9)) - (PROG (#0=#:G166105) - (SPADLET #0# (QUOTE T)) - (RETURN - (DO ((#1=#:G166112 NIL (NULL #0#)) (|i| 0 (QSADD1 |i|)) (#2=#:G166113 (ELT |dom| 5) (CDR #2#)) (|fdom| NIL)) - ((OR #1# (ATOM #2#) (PROGN (SETQ |fdom| (CAR #2#)) NIL)) #0#) - (SEQ - (EXIT - (SETQ #0# - (AND - #0# - (SPADCALL (ELT |x| |i|) (ELT |y| |i|) - (OR (ELT |equalfuns| |i|) - (SETELT |equalfuns| |i| (|findEqualFun| |fdom|)))))))))))) - ((QUOTE T) - (|error| (MAKESTRING "Bug: Silly record representation")))))))) + (PROG (|b| |equalfuns|) + (RETURN + (SEQ (COND + ((PAIRP |x|) + (SPADLET |b| + (SPADCALL (CAR |x|) (CAR |y|) + (OR (CAR (ELT |dom| 9)) + (CAR (RPLACA (ELT |dom| 9) + (|findEqualFun| + (ELT (ELT |dom| 5) 0))))))) + (COND + ((NULL (CDR (ELT |dom| 5))) |b|) + ('T + (AND |b| + (SPADCALL (CDR |x|) (CDR |y|) + (OR (CDR (ELT |dom| 9)) + (CDR (RPLACD (ELT |dom| 9) + (|findEqualFun| + (ELT (ELT |dom| 5) 1)))))))))) + ((VECP |x|) (SPADLET |equalfuns| (ELT |dom| 9)) + (PROG (G166105) + (SPADLET G166105 'T) + (RETURN + (DO ((G166112 NIL (NULL G166105)) + (|i| 0 (QSADD1 |i|)) + (G166113 (ELT |dom| 5) (CDR G166113)) + (|fdom| NIL)) + ((OR G166112 (ATOM G166113) + (PROGN (SETQ |fdom| (CAR G166113)) NIL)) + G166105) + (SEQ (EXIT (SETQ G166105 + (AND G166105 + (SPADCALL (ELT |x| |i|) + (ELT |y| |i|) + (OR (ELT |equalfuns| |i|) + (SETELT |equalfuns| |i| + (|findEqualFun| |fdom|)))))))))))) + ('T + (|error| "Bug: Silly record representation"))))))) + ;RecordPrint(x,dom) == coerceRe2E(x,dom.3) -(DEFUN |RecordPrint| (|x| |dom|) (|coerceRe2E| |x| (ELT |dom| 3))) +(DEFUN |RecordPrint| (|x| |dom|) (|coerceRe2E| |x| (ELT |dom| 3))) ;coerceVal2E(x,m) == ; objValUnwrap coerceByFunction(objNewWrap(x,m),$Expression) (DEFUN |coerceVal2E| (|x| |m|) - (|objValUnwrap| (|coerceByFunction| (|objNewWrap| |x| |m|) |$Expression|))) + (declare (special |$Expression|)) + (|objValUnwrap| + (|coerceByFunction| (|objNewWrap| |x| |m|) |$Expression|))) ;findEqualFun(dom) == ; compiledLookup('_=,[$Boolean,'$,'$],dom) (DEFUN |findEqualFun| (|dom|) - (|compiledLookup| (QUOTE =) - (CONS |$Boolean| (CONS (QUOTE $) (CONS (QUOTE $) NIL))) |dom|)) + (declare (special |$Boolean|)) + (|compiledLookup| '= (CONS |$Boolean| (CONS '$ (CONS '$ NIL))) |dom|)) ;coerceRe2E(x,source) == ; n := # CDR source @@ -230,66 +237,67 @@ ; error '"Bug: ridiculous record representation" (DEFUN |coerceRe2E| (|x| |source|) - (PROG (|n| |tag| |fdom|) - (RETURN - (SEQ - (PROGN - (SPADLET |n| (|#| (CDR |source|))) - (COND - ((EQL |n| 1) - (CONS - (QUOTE |construct|) - (CONS - (CONS - (QUOTE =) - (CONS - (ELT (ELT |source| 1) 1) - (CONS (|coerceVal2E| (CAR |x|) (ELT (ELT |source| 1) 2)) NIL))) - NIL))) - ((EQL |n| 2) - (CONS - (QUOTE |construct|) - (CONS - (CONS - (QUOTE =) - (CONS - (ELT (ELT |source| 1) 1) - (CONS (|coerceVal2E| (CAR |x|) (ELT (ELT |source| 1) 2)) NIL))) - (CONS - (CONS - (QUOTE =) - (CONS - (ELT (ELT |source| 2) 1) - (CONS (|coerceVal2E| (CDR |x|) (ELT (ELT |source| 2) 2)) NIL))) - NIL)))) - ((VECP |x|) - (CONS - (QUOTE |construct|) - (PROG (#0=#:G166146) - (SPADLET #0# NIL) - (RETURN - (DO ((|i| 0 (QSADD1 |i|)) - (#1=#:G166153 (CDR |source|) (CDR #1#)) - (#2=#:G166135 NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ #2# (CAR #1#)) NIL) - (PROGN - (PROGN - (SPADLET |tag| (CADR #2#)) - (SPADLET |fdom| (CADDR #2#)) - #2#) - NIL)) - (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS - (CONS - (QUOTE =) - (CONS |tag| (CONS (|coerceVal2E| (ELT |x| |i|) |fdom|) NIL))) - #0#))))))))) - ((QUOTE T) - (|error| (MAKESTRING "Bug: ridiculous record representation"))))))))) + (PROG (|n| |tag| |fdom|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|#| (CDR |source|))) + (COND + ((EQL |n| 1) + (CONS '|construct| + (CONS (CONS '= + (CONS (ELT (ELT |source| 1) 1) + (CONS + (|coerceVal2E| (CAR |x|) + (ELT (ELT |source| 1) 2)) + NIL))) + NIL))) + ((EQL |n| 2) + (CONS '|construct| + (CONS (CONS '= + (CONS (ELT (ELT |source| 1) 1) + (CONS + (|coerceVal2E| (CAR |x|) + (ELT (ELT |source| 1) 2)) + NIL))) + (CONS (CONS '= + (CONS (ELT (ELT |source| 2) 1) + (CONS + (|coerceVal2E| (CDR |x|) + (ELT (ELT |source| 2) 2)) + NIL))) + NIL)))) + ((VECP |x|) + (CONS '|construct| + (PROG (G166146) + (SPADLET G166146 NIL) + (RETURN + (DO ((|i| 0 (QSADD1 |i|)) + (G166153 (CDR |source|) + (CDR G166153)) + (G166135 NIL)) + ((OR (ATOM G166153) + (PROGN + (SETQ G166135 (CAR G166153)) + NIL) + (PROGN + (PROGN + (SPADLET |tag| (CADR G166135)) + (SPADLET |fdom| + (CADDR G166135)) + G166135) + NIL)) + (NREVERSE0 G166146)) + (SEQ (EXIT (SETQ G166146 + (CONS + (CONS '= + (CONS |tag| + (CONS + (|coerceVal2E| + (ELT |x| |i|) |fdom|) + NIL))) + G166146))))))))) + ('T + (|error| "Bug: ridiculous record representation")))))))) ;--% Union ;-- Want to eventually have the coerce to and from branch types. @@ -313,79 +321,86 @@ ; dom.8 := [function Undef, :dom] ; dom -(DEFUN |Union| (&REST #0=#:G166222 &AUX |args|) - (DSETQ |args| #0#) - (PROG (|dom| |ISTMP#1| |tag| |ISTMP#2| |domval|) - (RETURN - (SEQ - (PROGN - (SPADLET |dom| (GETREFV 9)) - (SETELT |dom| 0 - (CONS - (QUOTE |Union|) - (PROG (#1=#:G166195) - (SPADLET #1# NIL) - (RETURN - (DO ((#2=#:G166207 |args| (CDR #2#)) (|a| NIL)) - ((OR (ATOM #2#) (PROGN (SETQ |a| (CAR #2#)) NIL)) (NREVERSE0 #1#)) - (SEQ - (EXIT - (SETQ #1# - (CONS - (COND - ((AND (PAIRP |a|) - (EQ (QCAR |a|) (QUOTE |:|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |a|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |tag| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |domval| (QCAR |ISTMP#2|)) - (QUOTE T))))))) - (CONS - (QUOTE |:|) - (CONS |tag| (CONS (|devaluate| |domval|) NIL)))) - ((QUOTE T) (|devaluate| |a|))) - #1#))))))))) - (SETELT |dom| 1 - (CONS - (|function| |lookupInTable|) - (CONS - |dom| - (CONS - (CONS - (CONS - (QUOTE =) - (CONS - (CONS - (CONS - (CONS (QUOTE |Boolean|) NIL) - (CONS (QUOTE $) (CONS (QUOTE $) NIL))) - 12) - NIL)) - (CONS - (CONS - (QUOTE |coerce|) - (CONS (CONS (CONS |$Expression| (CONS (QUOTE $) NIL)) 14) NIL)) - NIL)) - NIL)))) - (SETELT |dom| 2 NIL) - (SETELT |dom| 3 (QUOTE (|SetCategory|))) - (SETELT |dom| 4 - (CONS - (CONS (QUOTE (|SetCategory|)) NIL) - (CONS (CONS (QUOTE (|SetCategory|)) NIL) NIL))) - (SETELT |dom| 5 |args|) - (SETELT |dom| 6 (CONS (|function| |UnionEqual|) |dom|)) - (SETELT |dom| 7 (CONS (|function| |UnionPrint|) |dom|)) - (SETELT |dom| 8 (CONS (|function| |Undef|) |dom|)) - |dom|))))) +(DEFUN |Union| (&REST G166222 &AUX |args|) + (DSETQ |args| G166222) + (PROG (|dom| |ISTMP#1| |tag| |ISTMP#2| |domval|) + (declare (special |$Expression|)) + (RETURN + (SEQ (PROGN + (SPADLET |dom| (GETREFV 9)) + (SETELT |dom| 0 + (CONS '|Union| + (PROG (G166195) + (SPADLET G166195 NIL) + (RETURN + (DO ((G166207 |args| (CDR G166207)) + (|a| NIL)) + ((OR (ATOM G166207) + (PROGN + (SETQ |a| (CAR G166207)) + NIL)) + (NREVERSE0 G166195)) + (SEQ (EXIT + (SETQ G166195 + (CONS + (COND + ((AND (PAIRP |a|) + (EQ (QCAR |a|) '|:|) + (PROGN + (SPADLET |ISTMP#1| + (QCDR |a|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |tag| + (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND + (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) + NIL) + (PROGN + (SPADLET |domval| + (QCAR |ISTMP#2|)) + 'T)))))) + (CONS '|:| + (CONS |tag| + (CONS + (|devaluate| |domval|) + NIL)))) + ('T (|devaluate| |a|))) + G166195))))))))) + (SETELT |dom| 1 + (CONS (|function| |lookupInTable|) + (CONS |dom| + (CONS (CONS + (CONS '= + (CONS + (CONS + (CONS (CONS '|Boolean| NIL) + (CONS '$ (CONS '$ NIL))) + 12) + NIL)) + (CONS + (CONS '|coerce| + (CONS + (CONS + (CONS |$Expression| + (CONS '$ NIL)) + 14) + NIL)) + NIL)) + NIL)))) + (SETELT |dom| 2 NIL) + (SETELT |dom| 3 '(|SetCategory|)) + (SETELT |dom| 4 + (CONS (CONS '(|SetCategory|) NIL) + (CONS (CONS '(|SetCategory|) NIL) NIL))) + (SETELT |dom| 5 |args|) + (SETELT |dom| 6 (CONS (|function| |UnionEqual|) |dom|)) + (SETELT |dom| 7 (CONS (|function| |UnionPrint|) |dom|)) + (SETELT |dom| 8 (CONS (|function| |Undef|) |dom|)) + |dom|))))) ;UnionEqual(x, y, dom) == ; ['Union,:branches] := dom.0 @@ -401,46 +416,51 @@ ; same (DEFUN |UnionEqual| (|x| |y| |dom|) - (PROG (|LETTMP#1| |branches| |predlist| |typeFun| |same|) - (RETURN - (SEQ - (PROGN - (SPADLET |LETTMP#1| (ELT |dom| 0)) - (SPADLET |branches| (CDR |LETTMP#1|)) - (SPADLET |branches| (|orderUnionEntries| |branches|)) - (SPADLET |predlist| (|mkPredList| |branches|)) - (SPADLET |same| NIL) - (DO ((#0=#:G166239 (|stripUnionTags| |branches|) (CDR #0#)) - (|b| NIL) - (#1=#:G166240 |predlist| (CDR #1#)) - (|p| NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ |b| (CAR #0#)) NIL) - (ATOM #1#) - (PROGN (SETQ |p| (CAR #1#)) NIL) - (NULL (NULL |same|))) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |typeFun| - (CONS (QUOTE LAMBDA) (CONS (QUOTE (|#1|)) (CONS |p| NIL)))) - (COND - ((AND (FUNCALL |typeFun| |x|) (FUNCALL |typeFun| |y|)) - (COND - ((STRINGP |b|) (SPADLET |same| (BOOT-EQUAL |x| |y|))) - ((QUOTE T) - (COND - ((AND (PAIRP |p|) (EQ (QCAR |p|) (QUOTE EQCAR))) - (SPADLET |x| (CDR |x|)) - (SPADLET |y| (CDR |y|)))) - (SPADLET |same| - (SPADCALL |x| |y| (|findEqualFun| (|evalDomain| |b|)))))))))))) - |same|))))) + (PROG (|LETTMP#1| |branches| |predlist| |typeFun| |same|) + (RETURN + (SEQ (PROGN + (SPADLET |LETTMP#1| (ELT |dom| 0)) + (SPADLET |branches| (CDR |LETTMP#1|)) + (SPADLET |branches| (|orderUnionEntries| |branches|)) + (SPADLET |predlist| (|mkPredList| |branches|)) + (SPADLET |same| NIL) + (DO ((G166239 (|stripUnionTags| |branches|) + (CDR G166239)) + (|b| NIL) (G166240 |predlist| (CDR G166240)) + (|p| NIL)) + ((OR (ATOM G166239) + (PROGN (SETQ |b| (CAR G166239)) NIL) + (ATOM G166240) + (PROGN (SETQ |p| (CAR G166240)) NIL) + (NULL (NULL |same|))) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |typeFun| + (CONS 'LAMBDA + (CONS '(|#1|) (CONS |p| NIL)))) + (COND + ((AND (FUNCALL |typeFun| |x|) + (FUNCALL |typeFun| |y|)) + (COND + ((STRINGP |b|) + (SPADLET |same| (BOOT-EQUAL |x| |y|))) + ('T + (COND + ((AND (PAIRP |p|) + (EQ (QCAR |p|) 'EQCAR)) + (SPADLET |x| (CDR |x|)) + (SPADLET |y| (CDR |y|)))) + (SPADLET |same| + (SPADCALL |x| |y| + (|findEqualFun| + (|evalDomain| |b|)))))))))))) + |same|))))) + ;UnionPrint(x, dom) == coerceUn2E(x, dom.0) -(DEFUN |UnionPrint| (|x| |dom|) (|coerceUn2E| |x| (ELT |dom| 0))) +(DEFUN |UnionPrint| (|x| |dom|) (|coerceUn2E| |x| (ELT |dom| 0))) + ;coerceUn2E(x,source) == ; ['Union,:branches] := source ; branches := orderUnionEntries branches @@ -458,44 +478,47 @@ ; byGeorge (DEFUN |coerceUn2E| (|x| |source|) - (PROG (|branches| |predlist| |byJane| |typeFun| |byGeorge|) - (RETURN - (SEQ - (PROGN - (SPADLET |branches| (CDR |source|)) - (SPADLET |branches| (|orderUnionEntries| |branches|)) - (SPADLET |predlist| (|mkPredList| |branches|)) - (SPADLET |byGeorge| (SPADLET |byJane| (GENSYM))) - (DO ((#0=#:G166279 (|stripUnionTags| |branches|) (CDR #0#)) - (|b| NIL) - (#1=#:G166280 |predlist| (CDR #1#)) - (|p| NIL)) - ((OR (ATOM #0#) - (PROGN (SETQ |b| (CAR #0#)) NIL) - (ATOM #1#) - (PROGN (SETQ |p| (CAR #1#)) NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |typeFun| - (CONS (QUOTE LAMBDA) (CONS (QUOTE (|#1|)) (CONS |p| NIL)))) - (COND - ((FUNCALL |typeFun| |x|) - (RETURN - (PROGN - (COND - ((AND (PAIRP |p|) (EQ (QCAR |p|) (QUOTE EQCAR))) - (SPADLET |x| (CDR |x|)))) + (PROG (|branches| |predlist| |byJane| |typeFun| |byGeorge|) + (RETURN + (SEQ (PROGN + (SPADLET |branches| (CDR |source|)) + (SPADLET |branches| (|orderUnionEntries| |branches|)) + (SPADLET |predlist| (|mkPredList| |branches|)) + (SPADLET |byGeorge| (SPADLET |byJane| (GENSYM))) + (DO ((G166279 (|stripUnionTags| |branches|) + (CDR G166279)) + (|b| NIL) (G166280 |predlist| (CDR G166280)) + (|p| NIL)) + ((OR (ATOM G166279) + (PROGN (SETQ |b| (CAR G166279)) NIL) + (ATOM G166280) + (PROGN (SETQ |p| (CAR G166280)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |typeFun| + (CONS 'LAMBDA + (CONS '(|#1|) (CONS |p| NIL)))) + (COND + ((FUNCALL |typeFun| |x|) + (RETURN + (PROGN + (COND + ((AND (PAIRP |p|) + (EQ (QCAR |p|) 'EQCAR)) + (SPADLET |x| (CDR |x|)))) + (COND + ((STRINGP |b|) + (SPADLET |byGeorge| |x|)) + ('T + (SPADLET |byGeorge| + (|coerceVal2E| |x| |b|))))))) + ('T NIL)))))) (COND - ((STRINGP |b|) (SPADLET |byGeorge| |x|)) - ((QUOTE T) (SPADLET |byGeorge| (|coerceVal2E| |x| |b|))))))) - ((QUOTE T) NIL)))))) - (COND - ((BOOT-EQUAL |byGeorge| |byJane|) - (|error| "Union bug: Cannot find appropriate branch for coerce to E")) - ((QUOTE T) |byGeorge|))))))) - + ((BOOT-EQUAL |byGeorge| |byJane|) + (|error| "Union bug: Cannot find appropriate branch for coerce to E")) + ('T |byGeorge|))))))) + + ;--% Mapping ;-- Want to eventually have elt: ($, args) -> target ;Mapping(:args) == @@ -516,63 +539,72 @@ ; dom.8 := [function Undef, :dom] ; dom -(DEFUN |Mapping| (&REST #0=#:G166322 &AUX |args|) - (DSETQ |args| #0#) - (PROG (|dom|) - (RETURN - (SEQ - (PROGN - (SPADLET |dom| (GETREFV 9)) - (SETELT |dom| 0 - (CONS - (QUOTE |Mapping|) - (PROG (#1=#:G166306) - (SPADLET #1# NIL) - (RETURN - (DO ((#2=#:G166311 |args| (CDR #2#)) (|a| NIL)) - ((OR (ATOM #2#) (PROGN (SETQ |a| (CAR #2#)) NIL)) (NREVERSE0 #1#)) - (SEQ (EXIT (SETQ #1# (CONS (|devaluate| |a|) #1#))))))))) - (SETELT |dom| 1 - (CONS - (|function| |lookupInTable|) - (CONS - |dom| - (CONS - (CONS - (CONS - (QUOTE =) - (CONS - (CONS - (CONS - (CONS (QUOTE |Boolean|) NIL) - (CONS (QUOTE $) (CONS (QUOTE $) NIL))) - 12) - NIL)) - (CONS - (CONS - (QUOTE |coerce|) - (CONS (CONS (CONS |$Expression| (CONS (QUOTE $) NIL)) 14) NIL)) - NIL)) - NIL)))) - (SETELT |dom| 2 NIL) - (SETELT |dom| 3 (QUOTE (|SetCategory|))) - (SETELT |dom| 4 - (CONS - (CONS (QUOTE (|SetCategory|)) NIL) - (CONS (CONS (QUOTE (|SetCategory|)) NIL) NIL))) - (SETELT |dom| 5 |args|) - (SETELT |dom| 6 (CONS (|function| |MappingEqual|) |dom|)) - (SETELT |dom| 7 (CONS (|function| |MappingPrint|) |dom|)) - (SETELT |dom| 8 (CONS (|function| |Undef|) |dom|)) - |dom|))))) +(DEFUN |Mapping| (&REST G166322 &AUX |args|) + (DSETQ |args| G166322) + (PROG (|dom|) + (declare (special |$Expression|)) + (RETURN + (SEQ (PROGN + (SPADLET |dom| (GETREFV 9)) + (SETELT |dom| 0 + (CONS '|Mapping| + (PROG (G166306) + (SPADLET G166306 NIL) + (RETURN + (DO ((G166311 |args| (CDR G166311)) + (|a| NIL)) + ((OR (ATOM G166311) + (PROGN + (SETQ |a| (CAR G166311)) + NIL)) + (NREVERSE0 G166306)) + (SEQ (EXIT + (SETQ G166306 + (CONS (|devaluate| |a|) + G166306))))))))) + (SETELT |dom| 1 + (CONS (|function| |lookupInTable|) + (CONS |dom| + (CONS (CONS + (CONS '= + (CONS + (CONS + (CONS (CONS '|Boolean| NIL) + (CONS '$ (CONS '$ NIL))) + 12) + NIL)) + (CONS + (CONS '|coerce| + (CONS + (CONS + (CONS |$Expression| + (CONS '$ NIL)) + 14) + NIL)) + NIL)) + NIL)))) + (SETELT |dom| 2 NIL) + (SETELT |dom| 3 '(|SetCategory|)) + (SETELT |dom| 4 + (CONS (CONS '(|SetCategory|) NIL) + (CONS (CONS '(|SetCategory|) NIL) NIL))) + (SETELT |dom| 5 |args|) + (SETELT |dom| 6 (CONS (|function| |MappingEqual|) |dom|)) + (SETELT |dom| 7 (CONS (|function| |MappingPrint|) |dom|)) + (SETELT |dom| 8 (CONS (|function| |Undef|) |dom|)) + |dom|))))) ;MappingEqual(x, y, dom) == EQ(x,y) -(DEFUN |MappingEqual| (|x| |y| |dom|) (EQ |x| |y|)) +(DEFUN |MappingEqual| (|x| |y| |dom|) + (declare (ignore |dom|)) + (EQ |x| |y|)) ;MappingPrint(x, dom) == coerceMap2E(x) -(DEFUN |MappingPrint| (|x| |dom|) (|coerceMap2E| |x|)) +(DEFUN |MappingPrint| (|x| |dom|) + (declare (ignore |dom|)) + (|coerceMap2E| |x|)) ;coerceMap2E(x) == ; -- nrlib domain @@ -582,18 +614,16 @@ ; ['theMap, BPINAME CAR x ] (DEFUN |coerceMap2E| (|x|) - (COND - ((ARRAYP (CDR |x|)) - (CONS - (QUOTE |theMap|) - (CONS - (BPINAME (CAR |x|)) - (CONS - (COND - (|$testingSystem| 0) - ((QUOTE T) (REMAINDER (HASHEQ (CDR |x|)) 1000))) - NIL)))) - ((QUOTE T) (CONS (QUOTE |theMap|) (CONS (BPINAME (CAR |x|)) NIL))))) + (declare (special |$testingSystem|)) + (COND + ((ARRAYP (CDR |x|)) + (CONS '|theMap| + (CONS (BPINAME (CAR |x|)) + (CONS (COND + (|$testingSystem| 0) + ('T (REMAINDER (HASHEQ (CDR |x|)) 1000))) + NIL)))) + ('T (CONS '|theMap| (CONS (BPINAME (CAR |x|)) NIL))))) ;--% Enumeration ;Enumeration(:"args") == @@ -615,60 +645,64 @@ ; dom.8 := [function createEnum, :dom] ; dom -(DEFUN |Enumeration,LAM| (&REST #0=#:G166339 &AUX |args|) - (DSETQ |args| #0#) - (PROG (|dom|) - (RETURN - (PROGN - (SPADLET |dom| (GETREFV 9)) - (SETELT |dom| 0 (CONS (QUOTE |Enumeration|) |args|)) - (SETELT |dom| 1 - (CONS - (|function| |lookupInTable|) - (CONS - |dom| - (CONS - (CONS - (CONS - (QUOTE =) - (CONS - (CONS - (CONS - (CONS (QUOTE |Boolean|) NIL) - (CONS (QUOTE $) (CONS (QUOTE $) NIL))) - 12) - NIL)) - (CONS - (CONS - (QUOTE |coerce|) - (CONS - (CONS (CONS |$Expression| (CONS (QUOTE $) NIL)) 14) - (CONS (CONS (CONS (QUOTE $) (CONS |$Symbol| NIL)) 16) NIL))) - NIL)) - NIL)))) - (SETELT |dom| 2 NIL) - (SETELT |dom| 3 (CONS (QUOTE |EnumerationCategory|) (QCDR (ELT |dom| 0)))) - (SETELT |dom| 4 - (CONS - (CONS (QUOTE (|SetCategory|)) NIL) - (CONS (CONS (QUOTE (|SetCategory|)) NIL) NIL))) - (SETELT |dom| 5 |args|) - (SETELT |dom| 6 (CONS (|function| |EnumEqual|) |dom|)) - (SETELT |dom| 7 (CONS (|function| |EnumPrint|) |dom|)) - (SETELT |dom| 8 (CONS (|function| |createEnum|) |dom|)) - |dom|)))) - -(DEFMACRO |Enumeration| (&WHOLE #0=#:G166340 &REST #:G166341 &AUX #1=#:G166338) - (DSETQ #1# #0#) - (CONS (QUOTE |Enumeration,LAM|) (VMLISP::WRAP (CDR #1#) (QUOTE QUOTE)))) +(DEFUN |Enumeration,LAM| (&REST G166339 &AUX |args|) + (DSETQ |args| G166339) + (PROG (|dom|) + (declare (special |$Symbol| |$Expression|)) + (RETURN + (PROGN + (SPADLET |dom| (GETREFV 9)) + (SETELT |dom| 0 (CONS '|Enumeration| |args|)) + (SETELT |dom| 1 + (CONS (|function| |lookupInTable|) + (CONS |dom| + (CONS (CONS (CONS '= + (CONS + (CONS + (CONS (CONS '|Boolean| NIL) + (CONS '$ (CONS '$ NIL))) + 12) + NIL)) + (CONS + (CONS '|coerce| + (CONS + (CONS + (CONS |$Expression| + (CONS '$ NIL)) + 14) + (CONS + (CONS + (CONS '$ + (CONS |$Symbol| NIL)) + 16) + NIL))) + NIL)) + NIL)))) + (SETELT |dom| 2 NIL) + (SETELT |dom| 3 + (CONS '|EnumerationCategory| (QCDR (ELT |dom| 0)))) + (SETELT |dom| 4 + (CONS (CONS '(|SetCategory|) NIL) + (CONS (CONS '(|SetCategory|) NIL) NIL))) + (SETELT |dom| 5 |args|) + (SETELT |dom| 6 (CONS (|function| |EnumEqual|) |dom|)) + (SETELT |dom| 7 (CONS (|function| |EnumPrint|) |dom|)) + (SETELT |dom| 8 (CONS (|function| |createEnum|) |dom|)) + |dom|)))) + +(DEFMACRO |Enumeration| (&WHOLE G166340 &REST G166341 &AUX G166338) + (DSETQ G166338 G166340) + (CONS '|Enumeration,LAM| (VMLISP::WRAP (CDR G166338) 'QUOTE))) ;EnumEqual(e1,e2,dom) == e1=e2 -(DEFUN |EnumEqual| (|e1| |e2| |dom|) (BOOT-EQUAL |e1| |e2|)) +(DEFUN |EnumEqual| (|e1| |e2| |dom|) + (declare (special |dom|)) + (BOOT-EQUAL |e1| |e2|)) ;EnumPrint(enum, dom) == dom.5.enum -(DEFUN |EnumPrint| (|enum| |dom|) (ELT (ELT |dom| 5) |enum|)) +(DEFUN |EnumPrint| (|enum| |dom|) (ELT (ELT |dom| 5) |enum|)) ;createEnum(sym, dom) == ; args := dom.5 @@ -679,66 +713,61 @@ ; val (DEFUN |createEnum| (|sym| |dom|) - (PROG (|args| |val|) - (RETURN - (SEQ - (PROGN - (SPADLET |args| (ELT |dom| 5)) - (SPADLET |val| (SPADDIFFERENCE 1)) - (SEQ - (DO ((#0=#:G166353 |args| (CDR #0#)) (|v| NIL) (|i| 0 (QSADD1 |i|))) - ((OR (ATOM #0#) (PROGN (SETQ |v| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (COND - ((BOOT-EQUAL |sym| |v|) (EXIT (RETURN (SPADLET |val| |i|)))))))) - (COND - ((MINUSP |val|) - (|error| - (CONS - (QUOTE |Cannot coerce|) - (CONS |sym| - (CONS - (QUOTE |to|) - (CONS (CONS (QUOTE |Enumeration|) |args|) NIL)))))) - ((QUOTE T) |val|)))))))) + (PROG (|args| |val|) + (RETURN + (SEQ (PROGN + (SPADLET |args| (ELT |dom| 5)) + (SPADLET |val| (SPADDIFFERENCE 1)) + (SEQ (DO ((G166353 |args| (CDR G166353)) (|v| NIL) + (|i| 0 (QSADD1 |i|))) + ((OR (ATOM G166353) + (PROGN (SETQ |v| (CAR G166353)) NIL)) + NIL) + (SEQ (EXIT (COND + ((BOOT-EQUAL |sym| |v|) + (EXIT (RETURN (SPADLET |val| |i|)))))))) + (COND + ((MINUSP |val|) + (|error| (CONS '|Cannot coerce| + (CONS |sym| + (CONS '|to| + (CONS + (CONS '|Enumeration| |args|) + NIL)))))) + ('T |val|)))))))) ;--% INSTANTIATORS ;RecordCategory(:"x") == constructorCategory ['Record,:x] -(DEFUN |RecordCategory,LAM| (&REST #0=#:G166369 &AUX |x|) - (DSETQ |x| #0#) - (|constructorCategory| (CONS (QUOTE |Record|) |x|))) +(DEFUN |RecordCategory,LAM| (&REST G166369 &AUX |x|) + (DSETQ |x| G166369) + (|constructorCategory| (CONS '|Record| |x|))) -(DEFMACRO |RecordCategory| - (&WHOLE #0=#:G166370 &REST #:G166371 &AUX #1=#:G166368) - (DSETQ #1# #0#) - (CONS (QUOTE |RecordCategory,LAM|) (VMLISP::WRAP (CDR #1#) (QUOTE QUOTE)))) +(DEFMACRO |RecordCategory| (&WHOLE G166370 &REST G166371 &AUX G166368) + (DSETQ G166368 G166370) + (CONS '|RecordCategory,LAM| (VMLISP::WRAP (CDR G166368) 'QUOTE))) ;EnumerationCategory(:"x") == constructorCategory ["Enumeration",:x] -(DEFUN |EnumerationCategory,LAM| (&REST #0=#:G166376 &AUX |x|) - (DSETQ |x| #0#) - (|constructorCategory| (CONS (QUOTE |Enumeration|) |x|))) +(DEFUN |EnumerationCategory,LAM| (&REST G166376 &AUX |x|) + (DSETQ |x| G166376) + (|constructorCategory| (CONS '|Enumeration| |x|))) -(DEFMACRO |EnumerationCategory| - (&WHOLE #0=#:G166377 &REST #:G166378 &AUX #1=#:G166375) - (DSETQ #1# #0#) - (CONS - (QUOTE |EnumerationCategory,LAM|) - (VMLISP::WRAP (CDR #1#) (QUOTE QUOTE)))) +(DEFMACRO |EnumerationCategory| (&WHOLE G166377 &REST G166378 &AUX G166375) + (DSETQ G166375 G166377) + (CONS '|EnumerationCategory,LAM| + (VMLISP::WRAP (CDR G166375) 'QUOTE))) ;UnionCategory(:"x") == constructorCategory ["Union",:x] -(DEFUN |UnionCategory,LAM| (&REST #0=#:G166383 &AUX |x|) - (DSETQ |x| #0#) - (|constructorCategory| (CONS (QUOTE |Union|) |x|))) +(DEFUN |UnionCategory,LAM| (&REST G166383 &AUX |x|) + (DSETQ |x| G166383) + (|constructorCategory| (CONS '|Union| |x|))) -(DEFMACRO |UnionCategory| - (&WHOLE #0=#:G166384 &REST #:G166385 &AUX #1=#:G166382) - (DSETQ #1# #0#) - (CONS (QUOTE |UnionCategory,LAM|) (VMLISP::WRAP (CDR #1#) (QUOTE QUOTE)))) +(DEFMACRO |UnionCategory| (&WHOLE G166384 &REST G166385 &AUX G166382) + (DSETQ G166382 G166384) + (CONS '|UnionCategory,LAM| (VMLISP::WRAP (CDR G166382) 'QUOTE))) ;--ListCategory(:"x") == constructorCategory ("List",:x) ;--VectorCategory(:"x") == constructorCategory ("Vector",:x) @@ -755,48 +784,52 @@ ; cat (DEFUN |constructorCategory| (|title|) - (PROG (|op| |constructorFunction| |LETTMP#1| |funlist| |a| |b| |c| - |oplist| |cat|) - (RETURN - (SEQ - (PROGN - (SPADLET |op| (CAR |title|)) - (SPADLET |constructorFunction| - (OR - (GETL |op| (QUOTE |makeFunctionList|)) - (|systemErrorHere| (MAKESTRING "constructorCategory")))) - (SPADLET |LETTMP#1| - (FUNCALL |constructorFunction| (QUOTE $) |title| |$CategoryFrame|)) - (SPADLET |funlist| (CAR |LETTMP#1|)) - (SPADLET |oplist| - (PROG (#0=#:G166415) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166421 |funlist| (CDR #1#)) (#2=#:G166391 NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ #2# (CAR #1#)) NIL) - (PROGN - (PROGN - (SPADLET |a| (CAR #2#)) - (SPADLET |b| (CADR #2#)) - (SPADLET |c| (CADDR #2#)) - #2#) - NIL)) - (NREVERSE0 #0#)) - (SEQ - (EXIT - (SETQ #0# - (CONS - (CONS (CONS |a| (CONS |b| NIL)) (CONS (QUOTE T) (CONS |c| NIL))) - #0#)))))))) - (SPADLET |cat| - (|JoinInner| - (CONS - (|SetCategory|) - (CONS (|mkCategory| (QUOTE |domain|) |oplist| NIL NIL NIL) NIL)) - |$EmptyEnvironment|)) - (SETELT |cat| 0 |title|) - |cat|))))) + (PROG (|op| |constructorFunction| |LETTMP#1| |funlist| |a| |b| |c| + |oplist| |cat|) + (declare (special |$EmptyEnvironment| |$CategoryFrame|)) + (RETURN + (SEQ (PROGN + (SPADLET |op| (CAR |title|)) + (SPADLET |constructorFunction| + (OR (GETL |op| '|makeFunctionList|) + (|systemErrorHere| "constructorCategory"))) + (SPADLET |LETTMP#1| + (FUNCALL |constructorFunction| '$ |title| + |$CategoryFrame|)) + (SPADLET |funlist| (CAR |LETTMP#1|)) + (SPADLET |oplist| + (PROG (G166415) + (SPADLET G166415 NIL) + (RETURN + (DO ((G166421 |funlist| (CDR G166421)) + (G166391 NIL)) + ((OR (ATOM G166421) + (PROGN + (SETQ G166391 (CAR G166421)) + NIL) + (PROGN + (PROGN + (SPADLET |a| (CAR G166391)) + (SPADLET |b| (CADR G166391)) + (SPADLET |c| (CADDR G166391)) + G166391) + NIL)) + (NREVERSE0 G166415)) + (SEQ (EXIT (SETQ G166415 + (CONS + (CONS + (CONS |a| (CONS |b| NIL)) + (CONS 'T (CONS |c| NIL))) + G166415)))))))) + (SPADLET |cat| + (|JoinInner| + (CONS (|SetCategory|) + (CONS (|mkCategory| '|domain| |oplist| + NIL NIL NIL) + NIL)) + |$EmptyEnvironment|)) + (SETELT |cat| 0 |title|) + |cat|))))) ;--mkMappingFunList(nam,mapForm,e) == [[],e] ;mkMappingFunList(nam,mapForm,e) == @@ -807,27 +840,31 @@ ; [substitute(nam,dc,substitute("$",'Rep,sigFunAlist)),e] (DEFUN |mkMappingFunList| (|nam| |mapForm| |e|) - (PROG (|dc| |sigFunAlist|) - (RETURN - (PROGN - (SPADLET |dc| (GENSYM)) - (SPADLET |sigFunAlist| - (CONS - (CONS - (QUOTE =) - (CONS - (CONS (CONS (QUOTE |Boolean|) NIL) (CONS |nam| (CONS |nam| NIL))) - (CONS (CONS (QUOTE ELT) (CONS |dc| (CONS 6 NIL))) NIL))) - (CONS - (CONS - (QUOTE |coerce|) - (CONS - (CONS |$Expression| (CONS |nam| NIL)) - (CONS (CONS (QUOTE ELT) (CONS |dc| (CONS 7 NIL))) NIL))) - NIL))) - (CONS - (MSUBST |nam| |dc| (MSUBST (QUOTE $) (QUOTE |Rep|) |sigFunAlist|)) - (CONS |e| NIL)))))) + (declare (ignore |mapForm|)) + (PROG (|dc| |sigFunAlist|) + (declare (special |$Expression|)) + (RETURN + (PROGN + (SPADLET |dc| (GENSYM)) + (SPADLET |sigFunAlist| + (CONS (CONS '= + (CONS (CONS (CONS '|Boolean| NIL) + (CONS |nam| (CONS |nam| NIL))) + (CONS + (CONS 'ELT + (CONS |dc| (CONS 6 NIL))) + NIL))) + (CONS (CONS '|coerce| + (CONS + (CONS |$Expression| + (CONS |nam| NIL)) + (CONS + (CONS 'ELT + (CONS |dc| (CONS 7 NIL))) + NIL))) + NIL))) + (CONS (MSUBST |nam| |dc| (MSUBST '$ '|Rep| |sigFunAlist|)) + (CONS |e| NIL)))))) ;mkRecordFunList(nam,['Record,:Alist],e) == ; len:= #Alist @@ -851,142 +888,178 @@ ; "$1",len]]]]] ; [substitute(nam,dc,substitute("$",'Rep,sigFunAlist)),e] -(DEFUN |mkRecordFunList| (|nam| #0=#:G166460 |e|) - (PROG (|Alist| |len| |dc| |a| A |sigFunAlist|) - (RETURN - (SEQ - (PROGN - (SPADLET |Alist| (CDR #0#)) - (SPADLET |len| (|#| |Alist|)) - (SPADLET |dc| (GENSYM)) - (SPADLET |sigFunAlist| - (CONS - (CONS - (QUOTE |construct|) - (CONS - (CONS - |nam| - (PROG (#1=#:G166481) - (SPADLET #1# NIL) - (RETURN - (DO ((#2=#:G166487 |Alist| (CDR #2#)) (#3=#:G166447 NIL)) - ((OR (ATOM #2#) - (PROGN (SETQ #3# (CAR #2#)) NIL) - (PROGN - (PROGN - (SPADLET |a| (CADR #3#)) - (SPADLET A (CADDR #3#)) - #3#) - NIL)) - (NREVERSE0 #1#)) - (SEQ (EXIT (SETQ #1# (CONS A #1#)))))))) - (CONS (QUOTE |mkRecord|) NIL))) - (CONS - (CONS - (QUOTE =) - (CONS - (CONS (CONS (QUOTE |Boolean|) NIL) (CONS |nam| (CONS |nam| NIL))) - (CONS (CONS (QUOTE ELT) (CONS |dc| (CONS 6 NIL))) NIL))) - (CONS - (CONS - (QUOTE |coerce|) - (CONS - (CONS |$Expression| (CONS |nam| NIL)) - (CONS (CONS (QUOTE ELT) (CONS |dc| (CONS 7 NIL))) NIL))) - (APPEND - (PROG (#4=#:G166500) - (SPADLET #4# NIL) - (RETURN - (DO ((|i| 0 (QSADD1 |i|)) - (#5=#:G166507 |Alist| (CDR #5#)) - (#6=#:G166451 NIL)) - ((OR (ATOM #5#) - (PROGN (SETQ #6# (CAR #5#)) NIL) - (PROGN - (PROGN - (SPADLET |a| (CADR #6#)) - (SPADLET A (CADDR #6#)) - #6#) - NIL)) - (NREVERSE0 #4#)) - (SEQ - (EXIT - (SETQ #4# - (CONS - (CONS - (QUOTE |elt|) - (CONS - (CONS A (CONS |nam| (CONS (PNAME |a|) NIL))) - (CONS - (CONS - (QUOTE XLAM) - (CONS - (CONS (QUOTE $1) (CONS (QUOTE $2) NIL)) - (CONS - (CONS - (QUOTE RECORDELT) - (CONS (QUOTE $1) (CONS |i| (CONS |len| NIL)))) - NIL))) - NIL))) - #4#))))))) - (APPEND - (PROG (#7=#:G166520) - (SPADLET #7# NIL) - (RETURN - (DO ((|i| 0 (QSADD1 |i|)) - (#8=#:G166527 |Alist| (CDR #8#)) - (#9=#:G166455 NIL)) - ((OR (ATOM #8#) - (PROGN (SETQ #9# (CAR #8#)) NIL) - (PROGN - (PROGN - (SPADLET |a| (CADR #9#)) - (SPADLET A (CADDR #9#)) - #9#) - NIL)) - (NREVERSE0 #7#)) - (SEQ - (EXIT - (SETQ #7# - (CONS - (CONS - (QUOTE |setelt|) - (CONS - (CONS A (CONS |nam| (CONS (PNAME |a|) (CONS A NIL)))) - (CONS - (CONS - (QUOTE XLAM) - (CONS - (CONS - (QUOTE $1) - (CONS (QUOTE $2) (CONS (QUOTE $3) NIL))) - (CONS - (CONS - (QUOTE SETRECORDELT) - (CONS - (QUOTE $1) - (CONS |i| (CONS |len| (CONS (QUOTE $3) NIL))))) - NIL))) - NIL))) - #7#))))))) - (CONS - (CONS - (QUOTE |copy|) - (CONS - (CONS |nam| (CONS |nam| NIL)) - (CONS - (CONS - (QUOTE XLAM) - (CONS - (CONS (QUOTE $1) NIL) - (CONS - (CONS (QUOTE RECORDCOPY) (CONS (QUOTE $1) (CONS |len| NIL))) - NIL))) - NIL))) - NIL))))))) - (CONS - (MSUBST |nam| |dc| (MSUBST (QUOTE $) (QUOTE |Rep|) |sigFunAlist|)) - (CONS |e| NIL))))))) +(DEFUN |mkRecordFunList| (|nam| G166460 |e|) + (PROG (|Alist| |len| |dc| |a| A |sigFunAlist|) + (declare (special |$Expression|)) + (RETURN + (SEQ (PROGN + (SPADLET |Alist| (CDR G166460)) + (SPADLET |len| (|#| |Alist|)) + (SPADLET |dc| (GENSYM)) + (SPADLET |sigFunAlist| + (CONS (CONS '|construct| + (CONS (CONS |nam| + (PROG (G166481) + (SPADLET G166481 NIL) + (RETURN + (DO + ((G166487 |Alist| + (CDR G166487)) + (G166447 NIL)) + ((OR (ATOM G166487) + (PROGN + (SETQ G166447 + (CAR G166487)) + NIL) + (PROGN + (PROGN + (SPADLET |a| + (CADR G166447)) + (SPADLET A + (CADDR G166447)) + G166447) + NIL)) + (NREVERSE0 G166481)) + (SEQ + (EXIT + (SETQ G166481 + (CONS A G166481)))))))) + (CONS '|mkRecord| NIL))) + (CONS (CONS '= + (CONS + (CONS (CONS '|Boolean| NIL) + (CONS |nam| (CONS |nam| NIL))) + (CONS + (CONS 'ELT + (CONS |dc| (CONS 6 NIL))) + NIL))) + (CONS (CONS '|coerce| + (CONS + (CONS |$Expression| + (CONS |nam| NIL)) + (CONS + (CONS 'ELT + (CONS |dc| (CONS 7 NIL))) + NIL))) + (APPEND + (PROG (G166500) + (SPADLET G166500 NIL) + (RETURN + (DO + ((|i| 0 (QSADD1 |i|)) + (G166507 |Alist| + (CDR G166507)) + (G166451 NIL)) + ((OR (ATOM G166507) + (PROGN + (SETQ G166451 + (CAR G166507)) + NIL) + (PROGN + (PROGN + (SPADLET |a| + (CADR G166451)) + (SPADLET A + (CADDR G166451)) + G166451) + NIL)) + (NREVERSE0 G166500)) + (SEQ + (EXIT + (SETQ G166500 + (CONS + (CONS '|elt| + (CONS + (CONS A + (CONS |nam| + (CONS + (PNAME |a|) + NIL))) + (CONS + (CONS 'XLAM + (CONS + (CONS '$1 + (CONS '$2 NIL)) + (CONS + (CONS + 'RECORDELT + (CONS '$1 + (CONS |i| + (CONS |len| + NIL)))) + NIL))) + NIL))) + G166500))))))) + (APPEND + (PROG (G166520) + (SPADLET G166520 NIL) + (RETURN + (DO + ((|i| 0 (QSADD1 |i|)) + (G166527 |Alist| + (CDR G166527)) + (G166455 NIL)) + ((OR (ATOM G166527) + (PROGN + (SETQ G166455 + (CAR G166527)) + NIL) + (PROGN + (PROGN + (SPADLET |a| + (CADR G166455)) + (SPADLET A + (CADDR G166455)) + G166455) + NIL)) + (NREVERSE0 G166520)) + (SEQ + (EXIT + (SETQ G166520 + (CONS + (CONS '|setelt| + (CONS + (CONS A + (CONS |nam| + (CONS + (PNAME |a|) + (CONS A NIL)))) + (CONS + (CONS 'XLAM + (CONS + (CONS '$1 + (CONS '$2 + (CONS '$3 + NIL))) + (CONS + (CONS + 'SETRECORDELT + (CONS '$1 + (CONS |i| + (CONS + |len| + (CONS '$3 + NIL))))) + NIL))) + NIL))) + G166520))))))) + (CONS + (CONS '|copy| + (CONS + (CONS |nam| + (CONS |nam| NIL)) + (CONS + (CONS 'XLAM + (CONS (CONS '$1 NIL) + (CONS + (CONS 'RECORDCOPY + (CONS '$1 + (CONS |len| NIL))) + NIL))) + NIL))) + NIL))))))) + (CONS (MSUBST |nam| |dc| (MSUBST '$ '|Rep| |sigFunAlist|)) + (CONS |e| NIL))))))) ;mkNewUnionFunList(name,form is ['Union,:listOfEntries],e) == ; dc := name @@ -1011,131 +1084,164 @@ ; [cList,e] (DEFUN |mkNewUnionFunList| (|name| |form| |e|) - (PROG (|listOfEntries| |dc| |tag| |type| |gg| |cList|) - (RETURN - (SEQ - (PROGN - (SPADLET |listOfEntries| (CDR |form|)) - (SPADLET |dc| |name|) - (COND ((BOOT-EQUAL |name| (QUOTE |Rep|)) (SPADLET |name| (QUOTE $)))) - (SPADLET |cList| - (CONS - (CONS - (QUOTE =) - (CONS - (CONS (CONS (QUOTE |Boolean|) NIL) (CONS |name| (CONS |name| NIL))) - (CONS (CONS (QUOTE ELT) (CONS |dc| (CONS 6 NIL))) NIL))) - (CONS - (CONS - (QUOTE |coerce|) - (CONS - (CONS |$Expression| (CONS |name| NIL)) - (CONS (CONS (QUOTE ELT) (CONS |dc| (CONS 7 NIL))) NIL))) - (PROG (#0=#:G166569) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166578 |listOfEntries| (CDR #1#)) - (#2=#:G166551 NIL) - (|i| 0 (QSADD1 |i|))) - ((OR (ATOM #1#) - (PROGN (SETQ #2# (CAR #1#)) NIL) - (PROGN - (PROGN - (SPADLET |tag| (CADR #2#)) - (SPADLET |type| (CADDR #2#)) - #2#) - NIL)) - #0#) - (SEQ - (EXIT - (SETQ #0# - (APPEND #0# - (CONS - (CONS - (QUOTE |construct|) - (CONS - (CONS |name| (CONS |type| NIL)) - (CONS - (CONS - (QUOTE XLAM) - (CONS - (CONS (QUOTE |#1|) NIL) - (CONS - (CONS (QUOTE CONS) (CONS |i| (CONS (QUOTE |#1|) NIL))) - NIL))) - NIL))) - (CONS - (CONS - (QUOTE |elt|) - (CONS - (CONS |type| (CONS |name| (CONS |tag| NIL))) - (CONS - (PROGN - (SPADLET |gg| (GENSYM)) - (COND - (|$InteractiveMode| - (CONS - (QUOTE XLAM) - (CONS - (CONS (QUOTE |#1|) NIL) - (CONS - (CONS - (QUOTE PROG1) - (CONS - (CONS (QUOTE QCDR) (CONS (QUOTE |#1|) NIL)) - (CONS - (CONS - (QUOTE |check-union|) - (CONS - (CONS - (QUOTE QEQCAR) - (CONS (QUOTE |#1|) (CONS |i| NIL))) - (CONS |type| (CONS (QUOTE |#1|) NIL)))) - NIL))) - NIL)))) - ((QUOTE T) - (CONS - (QUOTE XLAM) - (CONS - (CONS (QUOTE |#1|) NIL) - (CONS - (CONS - (QUOTE PROG2) - (CONS - (CONS - (QUOTE LET) - (CONS |gg| (CONS (QUOTE |#1|) NIL))) - (CONS - (CONS (QUOTE QCDR) (CONS |gg| NIL)) - (CONS - (CONS - (QUOTE |check-union|) - (CONS - (CONS - (QUOTE QEQCAR) - (CONS |gg| (CONS |i| NIL))) - (CONS |type| (CONS |gg| NIL)))) - NIL)))) - NIL)))))) - NIL))) - (CONS - (CONS - (QUOTE |case|) - (CONS - (CONS (QUOTE (|Boolean|)) (CONS |name| (CONS |tag| NIL))) - (CONS - (CONS - (QUOTE XLAM) - (CONS - (CONS (QUOTE |#1|) NIL) - (CONS - (CONS - (QUOTE QEQCAR) - (CONS (QUOTE |#1|) (CONS |i| NIL))) - NIL))) - NIL))) - NIL))))))))))))) - (CONS |cList| (CONS |e| NIL))))))) + (PROG (|listOfEntries| |dc| |tag| |type| |gg| |cList|) + (declare (special |$InteractiveMode| |$Expression|)) + (RETURN + (SEQ (PROGN + (SPADLET |listOfEntries| (CDR |form|)) + (SPADLET |dc| |name|) + (COND ((BOOT-EQUAL |name| '|Rep|) (SPADLET |name| '$))) + (SPADLET |cList| + (CONS (CONS '= + (CONS (CONS (CONS '|Boolean| NIL) + (CONS |name| + (CONS |name| NIL))) + (CONS + (CONS 'ELT + (CONS |dc| (CONS 6 NIL))) + NIL))) + (CONS (CONS '|coerce| + (CONS + (CONS |$Expression| + (CONS |name| NIL)) + (CONS + (CONS 'ELT + (CONS |dc| (CONS 7 NIL))) + NIL))) + (PROG (G166569) + (SPADLET G166569 NIL) + (RETURN + (DO + ((G166578 |listOfEntries| + (CDR G166578)) + (G166551 NIL) + (|i| 0 (QSADD1 |i|))) + ((OR (ATOM G166578) + (PROGN + (SETQ G166551 + (CAR G166578)) + NIL) + (PROGN + (PROGN + (SPADLET |tag| + (CADR G166551)) + (SPADLET |type| + (CADDR G166551)) + G166551) + NIL)) + G166569) + (SEQ + (EXIT + (SETQ G166569 + (APPEND G166569 + (CONS + (CONS '|construct| + (CONS + (CONS |name| + (CONS |type| NIL)) + (CONS + (CONS 'XLAM + (CONS (CONS '|#1| NIL) + (CONS + (CONS 'CONS + (CONS |i| + (CONS '|#1| NIL))) + NIL))) + NIL))) + (CONS + (CONS '|elt| + (CONS + (CONS |type| + (CONS |name| + (CONS |tag| NIL))) + (CONS + (PROGN + (SPADLET |gg| + (GENSYM)) + (COND + (|$InteractiveMode| + (CONS 'XLAM + (CONS + (CONS '|#1| + NIL) + (CONS + (CONS 'PROG1 + (CONS + (CONS 'QCDR + (CONS '|#1| + NIL)) + (CONS + (CONS + '|check-union| + (CONS + (CONS + 'QEQCAR + (CONS + '|#1| + (CONS + |i| + NIL))) + (CONS + |type| + (CONS + '|#1| + NIL)))) + NIL))) + NIL)))) + ('T + (CONS 'XLAM + (CONS + (CONS '|#1| + NIL) + (CONS + (CONS 'PROG2 + (CONS + (CONS 'LET + (CONS |gg| + (CONS + '|#1| + NIL))) + (CONS + (CONS 'QCDR + (CONS |gg| + NIL)) + (CONS + (CONS + '|check-union| + (CONS + (CONS + 'QEQCAR + (CONS + |gg| + (CONS + |i| + NIL))) + (CONS + |type| + (CONS + |gg| + NIL)))) + NIL)))) + NIL)))))) + NIL))) + (CONS + (CONS '|case| + (CONS + (CONS '(|Boolean|) + (CONS |name| + (CONS |tag| NIL))) + (CONS + (CONS 'XLAM + (CONS + (CONS '|#1| NIL) + (CONS + (CONS 'QEQCAR + (CONS '|#1| + (CONS |i| NIL))) + NIL))) + NIL))) + NIL))))))))))))) + (CONS |cList| (CONS |e| NIL))))))) ;mkEnumerationFunList(nam,['Enumeration,:SL],e) == ; len:= #SL @@ -1148,42 +1254,51 @@ ; ['coerce,[['OutputForm],nam],['ELT,dc, 9]]] ; [substitute(nam, dc, cList),e] -(DEFUN |mkEnumerationFunList| (|nam| #0=#:G166597 |e|) - (PROG (SL |len| |dc| |cList|) - (RETURN - (PROGN - (SPADLET SL (CDR #0#)) - (SPADLET |len| (|#| SL)) - (SPADLET |dc| |nam|) - (SPADLET |cList| - (CONS - NIL - (CONS - (CONS - (QUOTE =) - (CONS - (CONS (CONS (QUOTE |Boolean|) NIL) (CONS |nam| (CONS |nam| NIL))) - (CONS (CONS (QUOTE ELT) (CONS |dc| (CONS 6 NIL))) NIL))) - (CONS - (CONS - (QUOTE ^=) - (CONS - (CONS (CONS (QUOTE |Boolean|) NIL) (CONS |nam| (CONS |nam| NIL))) - (CONS (CONS (QUOTE ELT) (CONS |dc| (CONS 7 NIL))) NIL))) - (CONS - (CONS - (QUOTE |coerce|) - (CONS - (CONS |nam| (CONS (CONS (QUOTE |Symbol|) NIL) NIL)) - (CONS (CONS (QUOTE ELT) (CONS |dc| (CONS 8 NIL))) NIL))) - (CONS - (CONS - (QUOTE |coerce|) - (CONS - (CONS (CONS (QUOTE |OutputForm|) NIL) (CONS |nam| NIL)) - (CONS (CONS (QUOTE ELT) (CONS |dc| (CONS 9 NIL))) NIL))) - NIL)))))) - (CONS (MSUBST |nam| |dc| |cList|) (CONS |e| NIL)))))) +(DEFUN |mkEnumerationFunList| (|nam| G166597 |e|) + (PROG (SL |len| |dc| |cList|) + (RETURN + (PROGN + (SPADLET SL (CDR G166597)) + (SPADLET |len| (|#| SL)) + (SPADLET |dc| |nam|) + (SPADLET |cList| + (CONS NIL + (CONS (CONS '= + (CONS + (CONS (CONS '|Boolean| NIL) + (CONS |nam| (CONS |nam| NIL))) + (CONS + (CONS 'ELT + (CONS |dc| (CONS 6 NIL))) + NIL))) + (CONS (CONS '^= + (CONS + (CONS (CONS '|Boolean| NIL) + (CONS |nam| (CONS |nam| NIL))) + (CONS + (CONS 'ELT + (CONS |dc| (CONS 7 NIL))) + NIL))) + (CONS + (CONS '|coerce| + (CONS + (CONS |nam| + (CONS (CONS '|Symbol| NIL) NIL)) + (CONS + (CONS 'ELT + (CONS |dc| (CONS 8 NIL))) + NIL))) + (CONS + (CONS '|coerce| + (CONS + (CONS (CONS '|OutputForm| NIL) + (CONS |nam| NIL)) + (CONS + (CONS 'ELT + (CONS |dc| (CONS 9 NIL))) + NIL))) + NIL)))))) + (CONS (MSUBST |nam| |dc| |cList|) (CONS |e| NIL)))))) ;mkUnionFunList(op,form is ['Union,:listOfEntries],e) == ; first listOfEntries is [":",.,.] => mkNewUnionFunList(op,form,e) @@ -1230,222 +1345,332 @@ ; [cList,e] (DEFUN |mkUnionFunList| (|op| |form| |e|) - (PROG (|ISTMP#3| |listOfEntries| |predList| |g| |gg| |ref| |q| - |ISTMP#1| |x| |ISTMP#2| |n| |cList|) - (RETURN - (SEQ - (PROGN - (SPADLET |listOfEntries| (CDR |form|)) - (COND - ((PROGN (SPADLET |ISTMP#1| (CAR |listOfEntries|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) (QUOTE |:|)) - (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN + (PROG (|ISTMP#3| |listOfEntries| |predList| |g| |gg| |ref| |q| + |ISTMP#1| |x| |ISTMP#2| |n| |cList|) + (declare (special |$Expression|)) + (RETURN + (SEQ (PROGN + (SPADLET |listOfEntries| (CDR |form|)) + (COND + ((PROGN + (SPADLET |ISTMP#1| (CAR |listOfEntries|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) '|:|) + (PROGN + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL))))))) - (|mkNewUnionFunList| |op| |form| |e|)) - ((QUOTE T) - (SPADLET |listOfEntries| (|orderUnionEntries| |listOfEntries|)) - (SPADLET |predList| (|mkPredList| |listOfEntries|)) - (SPADLET |g| (GENSYM)) - (SPADLET |cList| - (CONS - (CONS - (QUOTE =) - (CONS - (CONS (CONS (QUOTE |Boolean|) NIL) (CONS |g| (CONS |g| NIL))) - (CONS (CONS (QUOTE ELT) (CONS |op| (CONS 6 NIL))) NIL))) - (CONS - (CONS - (QUOTE |coerce|) - (CONS - (CONS |$Expression| (CONS |g| NIL)) - (CONS (CONS (QUOTE ELT) (CONS |op| (CONS 7 NIL))) NIL))) - (PROG (#0=#:G166754) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G166789 |predList| (CDR #1#)) - (|p| NIL) - (#2=#:G166790 |listOfEntries| (CDR #2#)) - (|t| NIL)) - ((OR (ATOM #1#) - (PROGN (SETQ |p| (CAR #1#)) NIL) - (ATOM #2#) - (PROGN (SETQ |t| (CAR #2#)) NIL)) - #0#) - (SEQ - (EXIT - (SETQ #0# - (APPEND #0# - (CONS - (CONS - (QUOTE |autoCoerce|) - (CONS - (CONS |g| (CONS |t| NIL)) - (CONS - (COND - ((AND - (PAIRP |p|) - (EQ (QCAR |p|) (QUOTE EQCAR)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |p|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |x| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |n| (QCAR |ISTMP#2|)) - (QUOTE T))))))) - (CONS - (QUOTE XLAM) - (CONS - (CONS (QUOTE |#1|) NIL) - (CONS - (CONS - (QUOTE CONS) - (CONS |n| (CONS (QUOTE |#1|) NIL))) - NIL)))) - ((QUOTE T) - (CONS - (QUOTE XLAM) - (CONS - (CONS (QUOTE |#1|) NIL) - (CONS (QUOTE |#1|) NIL))))) - NIL))) - (CONS - (CONS - (QUOTE |coerce|) - (CONS - (CONS |t| (CONS |g| NIL)) - (CONS - (PROGN - (SPADLET |gg| (GENSYM)) - (COND - ((AND - (PAIRP |p|) - (EQ (QCAR |p|) (QUOTE EQCAR)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |p|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |x| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |n| (QCAR |ISTMP#2|)) - (QUOTE T))))))) - (SPADLET |ref| (CONS (QUOTE QCDR) (CONS |gg| NIL))) - (SPADLET |q| - (CONS (QUOTE QEQCAR) (CONS |gg| (CONS |n| NIL))))) - ((QUOTE T) - (SPADLET |ref| |gg|) - (SPADLET |q| (MSUBST |gg| (QUOTE |#1|) |p|)))) - (CONS - (QUOTE XLAM) - (CONS - (CONS (QUOTE |#1|) NIL) - (CONS - (CONS - (QUOTE PROG2) - (CONS - (CONS - (QUOTE LET) - (CONS |gg| (CONS (QUOTE |#1|) NIL))) - (CONS - |ref| - (CONS - (CONS - (QUOTE |check-union|) - (CONS |q| (CONS |t| (CONS |gg| NIL)))) - NIL)))) - NIL)))) - NIL))) - (CONS - (CONS - (QUOTE |autoCoerce|) - (CONS - (CONS |t| (CONS |g| NIL)) - (CONS - (COND - ((AND - (PAIRP |p|) - (EQ (QCAR |p|) (QUOTE EQCAR)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |p|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |x| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL)))))) - (CONS - (QUOTE XLAM) - (CONS - (CONS (QUOTE |#1|) NIL) - (CONS - (CONS (QUOTE QCDR) (CONS (QUOTE |#1|) NIL)) - NIL)))) - ((QUOTE T) - (CONS - (QUOTE XLAM) - (CONS - (CONS (QUOTE |#1|) NIL) - (CONS (QUOTE |#1|) NIL))))) - NIL))) - (CONS - (CONS - (QUOTE |case|) - (CONS - (CONS (QUOTE (|Boolean|)) (CONS |g| (CONS |t| NIL))) - (CONS - (COND - ((AND - (PAIRP |p|) - (EQ (QCAR |p|) (QUOTE EQCAR)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |p|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |x| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |n| (QCAR |ISTMP#2|)) - (QUOTE T))))))) - (CONS - (QUOTE XLAM) - (CONS - (CONS (QUOTE |#1|) NIL) - (CONS - (CONS (QUOTE QEQCAR) (CONS |x| (CONS |n| NIL))) - NIL)))) - ((QUOTE T) - (CONS - (QUOTE XLAM) - (CONS (CONS (QUOTE |#1|) NIL) (CONS |p| NIL))))) - NIL))) - NIL)))))))))))))) - (SPADLET |op| - (COND - ((BOOT-EQUAL |op| (QUOTE |Rep|)) (QUOTE $)) - ((QUOTE T) |op|))) - (SPADLET |cList| (MSUBST |op| |g| |cList|)) - (CONS |cList| (CONS |e| NIL))))))))) + (|mkNewUnionFunList| |op| |form| |e|)) + ('T + (SPADLET |listOfEntries| + (|orderUnionEntries| |listOfEntries|)) + (SPADLET |predList| (|mkPredList| |listOfEntries|)) + (SPADLET |g| (GENSYM)) + (SPADLET |cList| + (CONS (CONS '= + (CONS + (CONS (CONS '|Boolean| NIL) + (CONS |g| (CONS |g| NIL))) + (CONS + (CONS 'ELT + (CONS |op| (CONS 6 NIL))) + NIL))) + (CONS (CONS '|coerce| + (CONS + (CONS |$Expression| + (CONS |g| NIL)) + (CONS + (CONS 'ELT + (CONS |op| (CONS 7 NIL))) + NIL))) + (PROG (G166754) + (SPADLET G166754 NIL) + (RETURN + (DO + ((G166789 |predList| + (CDR G166789)) + (|p| NIL) + (G166790 |listOfEntries| + (CDR G166790)) + (|t| NIL)) + ((OR (ATOM G166789) + (PROGN + (SETQ |p| + (CAR G166789)) + NIL) + (ATOM G166790) + (PROGN + (SETQ |t| + (CAR G166790)) + NIL)) + G166754) + (SEQ + (EXIT + (SETQ G166754 + (APPEND G166754 + (CONS + (CONS '|autoCoerce| + (CONS + (CONS |g| + (CONS |t| NIL)) + (CONS + (COND + ((AND (PAIRP |p|) + (EQ (QCAR |p|) + 'EQCAR) + (PROGN + (SPADLET + |ISTMP#1| + (QCDR |p|)) + (AND + (PAIRP + |ISTMP#1|) + (PROGN + (SPADLET + |x| + (QCAR + |ISTMP#1|)) + (SPADLET + |ISTMP#2| + (QCDR + |ISTMP#1|)) + (AND + (PAIRP + |ISTMP#2|) + (EQ + (QCDR + |ISTMP#2|) + NIL) + (PROGN + (SPADLET + |n| + (QCAR + |ISTMP#2|)) + 'T)))))) + (CONS 'XLAM + (CONS + (CONS '|#1| + NIL) + (CONS + (CONS 'CONS + (CONS |n| + (CONS '|#1| + NIL))) + NIL)))) + ('T + (CONS 'XLAM + (CONS + (CONS '|#1| + NIL) + (CONS '|#1| + NIL))))) + NIL))) + (CONS + (CONS '|coerce| + (CONS + (CONS |t| + (CONS |g| NIL)) + (CONS + (PROGN + (SPADLET |gg| + (GENSYM)) + (COND + ((AND + (PAIRP |p|) + (EQ + (QCAR |p|) + 'EQCAR) + (PROGN + (SPADLET + |ISTMP#1| + (QCDR |p|)) + (AND + (PAIRP + |ISTMP#1|) + (PROGN + (SPADLET + |x| + (QCAR + |ISTMP#1|)) + (SPADLET + |ISTMP#2| + (QCDR + |ISTMP#1|)) + (AND + (PAIRP + |ISTMP#2|) + (EQ + (QCDR + |ISTMP#2|) + NIL) + (PROGN + (SPADLET + |n| + (QCAR + |ISTMP#2|)) + 'T)))))) + (SPADLET |ref| + (CONS 'QCDR + (CONS |gg| + NIL))) + (SPADLET |q| + (CONS 'QEQCAR + (CONS |gg| + (CONS |n| + NIL))))) + ('T + (SPADLET |ref| + |gg|) + (SPADLET |q| + (MSUBST |gg| + '|#1| |p|)))) + (CONS 'XLAM + (CONS + (CONS '|#1| + NIL) + (CONS + (CONS 'PROG2 + (CONS + (CONS 'LET + (CONS |gg| + (CONS + '|#1| + NIL))) + (CONS |ref| + (CONS + (CONS + '|check-union| + (CONS |q| + (CONS + |t| + (CONS + |gg| + NIL)))) + NIL)))) + NIL)))) + NIL))) + (CONS + (CONS '|autoCoerce| + (CONS + (CONS |t| + (CONS |g| NIL)) + (CONS + (COND + ((AND + (PAIRP |p|) + (EQ (QCAR |p|) + 'EQCAR) + (PROGN + (SPADLET + |ISTMP#1| + (QCDR |p|)) + (AND + (PAIRP + |ISTMP#1|) + (PROGN + (SPADLET + |x| + (QCAR + |ISTMP#1|)) + (SPADLET + |ISTMP#2| + (QCDR + |ISTMP#1|)) + (AND + (PAIRP + |ISTMP#2|) + (EQ + (QCDR + |ISTMP#2|) + NIL)))))) + (CONS 'XLAM + (CONS + (CONS '|#1| + NIL) + (CONS + (CONS 'QCDR + (CONS '|#1| + NIL)) + NIL)))) + ('T + (CONS 'XLAM + (CONS + (CONS '|#1| + NIL) + (CONS '|#1| + NIL))))) + NIL))) + (CONS + (CONS '|case| + (CONS + (CONS '(|Boolean|) + (CONS |g| + (CONS |t| NIL))) + (CONS + (COND + ((AND + (PAIRP |p|) + (EQ + (QCAR |p|) + 'EQCAR) + (PROGN + (SPADLET + |ISTMP#1| + (QCDR |p|)) + (AND + (PAIRP + |ISTMP#1|) + (PROGN + (SPADLET + |x| + (QCAR + |ISTMP#1|)) + (SPADLET + |ISTMP#2| + (QCDR + |ISTMP#1|)) + (AND + (PAIRP + |ISTMP#2|) + (EQ + (QCDR + |ISTMP#2|) + NIL) + (PROGN + (SPADLET + |n| + (QCAR + |ISTMP#2|)) + 'T)))))) + (CONS 'XLAM + (CONS + (CONS '|#1| + NIL) + (CONS + (CONS + 'QEQCAR + (CONS |x| + (CONS |n| + NIL))) + NIL)))) + ('T + (CONS 'XLAM + (CONS + (CONS '|#1| + NIL) + (CONS |p| + NIL))))) + NIL))) + NIL)))))))))))))) + (SPADLET |op| + (COND + ((BOOT-EQUAL |op| '|Rep|) '$) + ('T |op|))) + (SPADLET |cList| (MSUBST |op| |g| |cList|)) + (CONS |cList| (CONS |e| NIL))))))))) + @ \eject