diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 647e142..098234f 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -33143,7 +33143,6 @@ alternate polynomial types of Symbols. \calls{evalDomain}{concat} \calls{evalDomain}{prefix2String} \calls{evalDomain}{startTimingProcess} -\calls{evalDomain}{newType?} \calls{evalDomain}{eval} \calls{evalDomain}{mkEvalable} \calls{evalDomain}{stopTimingProcess} @@ -33156,12 +33155,9 @@ alternate polynomial types of Symbols. (|sayMSG| (|concat| " instantiating" '|%b| (|prefix2String| form) '|%d|))) (|startTimingProcess| '|instantiation|) - (cond - ((|newType?| form) form) - ('t - (setq result (|eval| (|mkEvalable| form))) - (|stopTimingProcess| '|instantiation|) - result)))) + (setq result (|eval| (|mkEvalable| form))) + (|stopTimingProcess| '|instantiation|) + result)) \end{chunk} @@ -38169,6 +38165,14 @@ but the Axiom semantics are not the same. Because Axiom was originally written in Maclisp, then VMLisp, and then Common Lisp some of these old semantics survive. +\section{NumberFormats} +\defun{ncParseFromString}{ncParseFromString} +\begin{chunk}{defun ncParseFromString} +(defun |ncParseFromString| (s) + (|zeroOneTran| (catch 'SPAD_READER (|parseFromString| s)))) + +\end{chunk} + \section{SingleInteger} \defun{qsquotient}{qsquotient} \begin{chunk}{defun qsquotient 0} @@ -41079,6 +41083,7 @@ This needs to work off the internal exposure list, not the file. \getchunk{defun ncloopInclude1} \getchunk{defun ncloopParse} \getchunk{defun ncParseAndInterpretString} +\getchunk{defun ncParseFromString} \getchunk{defun ncPutQ} \getchunk{defun ncSoftError} \getchunk{defun ncTag} diff --git a/changelog b/changelog index e968b66..89ed54d 100644 --- a/changelog +++ b/changelog @@ -1,10 +1,18 @@ +20110923 tpd src/axiom-website/patches.html 20110923.03.tpd.patch +20110923 tpd src/interp/parsing.lisp remove nci.lisp +20110923 tpd src/interp/nci.lisp removed +20110923 tpd src/interp/i-util.lisp remove nci.lisp +20110923 tpd src/interp/i-eval.lisp remove nci.lisp +20110923 tpd src/interp/i-coerce.lisp remove nci.lisp +20110923 tpd src/interp/Makefile remove nci.lisp +20110923 tpd books/bookvol5 remove nci.lisp 20110923 tpd src/axiom-website/patches.html 20110923.02.tpd.patch 20110923 tpd src/interp/nci.lisp remove packageTran 20110923 tpd books/bookvol5 remove packageTran 20110923 tpd books/bookvol10.4 remove packageTran 20110923 tpd src/axiom-website/patches.html 20110923.01.tpd.patch 20110923 tpd src/interp/vmlisp.lisp add qfirst, etc -20110923 src/interp/sys-pkg.lisp add qfirst, etc +20110923 tpd src/interp/sys-pkg.lisp add qfirst, etc 20110923 tpd books/bookvol9 use qc(ad)r forms 20110923 tpd books/bookvol5 use qc(ad)r forms 20110916 tpd src/axiom-website/patches.html 20110916.01.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 428ba47..187ff86 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3626,5 +3626,7 @@ src/interp/vmlisp.lisp remove pairp
src/interp/vmlisp.lisp, bookvol5, bookvol9 use qc(ad)r forms 20110923.02.tpd.patch books/bookvol5 remove packageTran
+20110923.03.tpd.patch +src/interp/Makefile remove nci.lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 31bfbb0..c61d8aa 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -160,7 +160,7 @@ OBJS= ${OUT}/vmlisp.${O} \ ${OUT}/i-util.${O} \ ${OUT}/lisplib.${O} \ ${OUT}/match.${O} \ - ${OUT}/msgdb.${O} ${OUT}/nci.${O} \ + ${OUT}/msgdb.${O} \ ${OUT}/newfort.${O} \ ${OUT}/nrunfast.${O} \ ${OUT}/nrungo.${O} ${OUT}/nrunopt.${O} \ @@ -2920,29 +2920,6 @@ ${MID}/posit.lisp: ${IN}/posit.lisp.pamphlet @ -\subsection{nci.lisp} -<>= -${OUT}/nci.${O}: ${MID}/nci.lisp - @ echo 558 making ${OUT}/nci.${O} from ${MID}/nci.lisp - @ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/nci.lisp"' \ - ':output-file "${OUT}/nci.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/nci.lisp"' \ - ':output-file "${OUT}/nci.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi - -@ -<>= -${MID}/nci.lisp: ${IN}/nci.lisp.pamphlet - @ echo 559 making ${MID}/nci.lisp from ${IN}/nci.lisp.pamphlet - @(cd ${MID} ; \ - echo '(tangle "${IN}/nci.lisp.pamphlet" "*" "nci.lisp")' \ - | ${OBJ}/${SYS}/bin/lisp ) - -@ - \subsection{sfsfun-l.lisp} <>= ${OUT}/sfsfun-l.${O}: ${MID}/sfsfun-l.lisp @@ -3297,9 +3274,6 @@ clean: <> <> -<> -<> - <> <> diff --git a/src/interp/i-coerce.lisp.pamphlet b/src/interp/i-coerce.lisp.pamphlet index 8d1f5ef..1b82823 100644 --- a/src/interp/i-coerce.lisp.pamphlet +++ b/src/interp/i-coerce.lisp.pamphlet @@ -4350,7 +4350,7 @@ Interpreter Coercion Query Functions (DECLARE (SPECIAL |$coerceFailure| |$OutputForm|)) (RETURN (COND - ((AND (BOOT-EQUAL |t2| |$OutputForm|) (NULL (|newType?| |t1|))) + ((equal |t2| |$OutputForm|) NIL) ((|isWrapped| |x|) (SPADLET |x| (|unwrap| |x|)) (SPADLET |c| diff --git a/src/interp/i-eval.lisp.pamphlet b/src/interp/i-eval.lisp.pamphlet index b58a92c..b48f45a 100644 --- a/src/interp/i-eval.lisp.pamphlet +++ b/src/interp/i-eval.lisp.pamphlet @@ -463,13 +463,8 @@ (TAKE (|#| |xargs|) |form|)))))) ((QUOTE T) (SPADLET |dcVector| (|evalDomain| |dc|)) - (SPADLET |fun0| - (COND - ((|newType?| (CAAR |mm|)) - (SPADLET |mm'| (CAR (|ncSigTransform| |mm|))) - (|ncGetFunction| |opName| (CAR |mm'|) (CDR |mm'|))) - ((QUOTE T) - (|NRTcompileEvalForm| |opName| |fun| |dcVector|)))) + (SPADLET |fun0| + (|NRTcompileEvalForm| |opName| |fun| |dcVector|)) (COND ((NULL |fun0|) (|throwKeyedMsg| (QUOTE S2IE0008) (CONS |opName| NIL))) diff --git a/src/interp/i-util.lisp.pamphlet b/src/interp/i-util.lisp.pamphlet index fb313b5..02cd65b 100644 --- a/src/interp/i-util.lisp.pamphlet +++ b/src/interp/i-util.lisp.pamphlet @@ -245,12 +245,6 @@ lisp code is unwrapped. 0) ('T (RPLACD |p| (PLUS 1 (CDR |p|))) (CDR |p|))))))) -;newType? t == nil - -(DEFUN |newType?| (|t|) - (declare (ignore |t|)) - nil) - ;-- functions used at run-time which were formerly in the compiler files ;Undef(:u) == ; u':= LAST u diff --git a/src/interp/nci.lisp.pamphlet b/src/interp/nci.lisp.pamphlet deleted file mode 100644 index 9459475..0000000 --- a/src/interp/nci.lisp.pamphlet +++ /dev/null @@ -1,47 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nci.lisp} -\author{Timothy Daly} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\begin{chunk}{*} - -(in-package "BOOT") - -;; Interpreter interface to new compiler - - -(defun |ncParseFromString| (s) - (|zeroOneTran| - (catch 'SPAD_READER (|parseFromString| s)))) - -(defun |ncGetFunction| (op dom sig) - (|applyInPackage| #'|getNCfunction| - (list (|rePackageTran| op "boot") - (|rePackageTran| dom "boot") - (|rePackageTran| sig "boot")) - "boot")) - -(defun |rePackageTran| (sex package) - (let (*package*) - (declare (special *package*)) - (setq *package* (find-package (string package))) - sex)) - -(defun |applyInPackage| (fun args package) - (let ((*package* (find-package (string package)))) - (declare (special *package*)) - (apply fun args))) - - -\end{chunk} -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index 336ece5..1054062 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -1018,7 +1018,15 @@ parse ;;; *** |parseBigelt| REDEFINED -(DEFUN |parseBigelt| (#0=#:G166338) (PROG (|typ| |consForm|) (RETURN (PROGN (SPADLET |typ| (CAR #0#)) (SPADLET |consForm| (CADR #0#)) (CONS (CONS (QUOTE |elt|) (CONS |typ| (CONS (QUOTE |makeRecord|) NIL))) (|transUnCons| |consForm|)))))) +(DEFUN |parseBigelt| (arg) + (PROG (|typ| |consForm|) + (RETURN + (PROGN + (SPADLET |typ| (CAR arg)) + (SPADLET |consForm| (CADR arg)) + (CONS (CONS '|elt| (CONS |typ| (CONS '|makeRecord| NIL))) + (|transUnCons| |consForm|)))))) + ; ;transUnCons u == ; atom u => systemErrorHere '"transUnCons" @@ -1031,7 +1039,37 @@ parse ;;; *** |transUnCons| REDEFINED -(DEFUN |transUnCons| (|u|) (PROG (|ISTMP#1| |x| |ISTMP#2| |y|) (RETURN (COND ((ATOM |u|) (|systemErrorHere| "transUnCons")) ((AND (CONSP |u|) (EQ (QCAR |u|) (QUOTE APPEND)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (CONSP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((NULL |y|) |x|) ((QUOTE T) (|systemErrorHere| "transUnCons")))) ((AND (CONSP |u|) (EQ (QCAR |u|) (QUOTE CONS)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (CONSP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((ATOM |y|) (CONS |x| |y|)) ((QUOTE T) (CONS |x| (|transUnCons| |y|))))))))) +(DEFUN |transUnCons| (|u|) + (PROG (|ISTMP#1| |x| |ISTMP#2| |y|) + (RETURN + (COND + ((ATOM |u|) (|systemErrorHere| "transUnCons")) + ((AND (CONSP |u|) (EQ (QCAR |u|) 'APPEND) + (PROGN + (SPADLET |ISTMP#1| (QCDR |u|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SPADLET |x| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) 'T)))))) + (COND + ((NULL |y|) |x|) + ('T (|systemErrorHere| "transUnCons")))) + ((AND (CONSP |u|) (EQ (QCAR |u|) 'CONS) + (PROGN + (SPADLET |ISTMP#1| (QCDR |u|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SPADLET |x| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) 'T)))))) + (COND + ((ATOM |y|) (CONS |x| |y|)) + ('T (CONS |x| (|transUnCons| |y|))))))))) + + ; ;parseTypeEvaluate form == ; form is [op,:argl] => @@ -1058,7 +1096,152 @@ parse ;;; *** |parseTypeEvaluate| REDEFINED -(DEFUN |parseTypeEvaluate| (|form|) (PROG (|$op| |op| |argl| |sel| |type| |fn| |p| |cmm| |ISTMP#1| |ISTMP#2| |argml|) (DECLARE (SPECIAL |$op|)) (RETURN (SEQ (COND ((AND (CONSP |form|) (PROGN (SPADLET |op| (QCAR |form|)) (SPADLET |argl| (QCDR |form|)) (QUOTE T))) (COND ((|newType?| |op|) |form|) ((QUOTE T) (SPADLET |$op| |op|) (COND ((BOOT-EQUAL |op| (QUOTE |Mapping|)) (CONS |op| (PROG (#0=#:G166484) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166489 |argl| (CDR #1#)) (|a| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |a| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|parseTypeEvaluate| |a|) #0#))))))))) ((BOOT-EQUAL |op| (QUOTE |Union|)) (COND ((|isTaggedUnion| |form|) (CONS |op| (PROG (#2=#:G166500) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G166506 |argl| (CDR #3#)) (#4=#:G166457 NIL)) ((OR (ATOM #3#) (PROGN (SETQ #4# (CAR #3#)) NIL) (PROGN (PROGN (SPADLET |sel| (CADR #4#)) (SPADLET |type| (CADDR #4#)) #4#) NIL)) (NREVERSE0 #2#)) (SEQ (EXIT (SETQ #2# (CONS (CONS (QUOTE |:|) (CONS |sel| (CONS (|parseTypeEvaluate| |type|) NIL))) #2#))))))))) ((QUOTE T) (CONS |op| (PROG (#5=#:G166517) (SPADLET #5# NIL) (RETURN (DO ((#6=#:G166522 |argl| (CDR #6#)) (|a| NIL)) ((OR (ATOM #6#) (PROGN (SETQ |a| (CAR #6#)) NIL)) (NREVERSE0 #5#)) (SEQ (EXIT (SETQ #5# (CONS (|parseTypeEvaluate| |a|) #5#))))))))))) ((BOOT-EQUAL |op| (QUOTE |Record|)) (CONS |op| (PROG (#7=#:G166533) (SPADLET #7# NIL) (RETURN (DO ((#8=#:G166539 |argl| (CDR #8#)) (#9=#:G166462 NIL)) ((OR (ATOM #8#) (PROGN (SETQ #9# (CAR #8#)) NIL) (PROGN (PROGN (SPADLET |sel| (CADR #9#)) (SPADLET |type| (CADDR #9#)) #9#) NIL)) (NREVERSE0 #7#)) (SEQ (EXIT (SETQ #7# (CONS (CONS (QUOTE |:|) (CONS |sel| (CONS (|parseTypeEvaluate| |type|) NIL))) #7#))))))))) ((QUOTE T) (SPADLET |cmm| (SEQ (COND ((SPADLET |fn| (|constructor?| |op|)) (COND ((SPADLET |p| (|pathname| (CONS |fn| (CONS |$spadLibFT| (CONS "*" NIL))))) (EXIT (COND ((|isExistingFile| |p|) (|getConstructorModemap| (|abbreviation?| |fn|))) ((QUOTE T) NIL)))))) ((QUOTE T) NIL)))) (COND ((AND (CONSP |cmm|) (PROGN (SPADLET |ISTMP#1| (QCAR |cmm|)) (AND (CONSP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (PROGN (SPADLET |argml| (QCDR |ISTMP#2|)) (QUOTE T))))))) (CONS |op| (|parseTypeEvaluateArgs| |argl| |argml|))) ((QUOTE T) (|throwKeyedMsg| (QUOTE S2IL0015) (CONS |op| NIL))))))))) ((QUOTE T) |form|)))))) +(DEFUN |parseTypeEvaluate| (|form|) + (PROG (|$op| |op| |argl| |sel| |type| |fn| |p| |cmm| |ISTMP#1| + |ISTMP#2| |argml|) + (DECLARE (SPECIAL |$op|)) + (RETURN + (SEQ (COND + ((AND (CONSP |form|) + (PROGN + (SPADLET |op| (QCAR |form|)) + (SPADLET |argl| (QCDR |form|)) + 'T)) + (SPADLET |$op| |op|) + (COND + ((BOOT-EQUAL |op| '|Mapping|) + (CONS |op| + (PROG (tpd1) + (SPADLET tpd1 NIL) + (RETURN + (DO ((tpd2 |argl| (CDR tpd2)) + (|a| NIL)) + ((OR (ATOM tpd2) + (PROGN + (SETQ |a| (CAR tpd2)) + NIL)) + (NREVERSE0 tpd1)) + (SEQ (EXIT + (SETQ tpd1 + (CONS (|parseTypeEvaluate| |a|) + tpd1))))))))) + ((BOOT-EQUAL |op| '|Union|) + (COND + ((|isTaggedUnion| |form|) + (CONS |op| + (PROG (tpd3) + (SPADLET tpd3 NIL) + (RETURN + (DO ((tpd4 |argl| + (CDR tpd4)) + (tpd5 NIL)) + ((OR (ATOM tpd4) + (PROGN + (SETQ tpd5 + (CAR tpd4)) + NIL) + (PROGN + (PROGN + (SPADLET |sel| + (CADR tpd5)) + (SPADLET |type| + (CADDR tpd5)) + tpd5) + NIL)) + (NREVERSE0 tpd3)) + (SEQ + (EXIT + (SETQ tpd3 + (CONS + (CONS '|:| + (CONS |sel| + (CONS + (|parseTypeEvaluate| |type|) + NIL))) + tpd3))))))))) + ('T + (CONS |op| + (PROG (tpd6) + (SPADLET tpd6 NIL) + (RETURN + (DO ((tpd7 |argl| + (CDR tpd7)) + (|a| NIL)) + ((OR (ATOM tpd7) + (PROGN + (SETQ |a| (CAR tpd7)) + NIL)) + (NREVERSE0 tpd6)) + (SEQ + (EXIT + (SETQ tpd6 + (CONS (|parseTypeEvaluate| |a|) + tpd6))))))))))) + ((BOOT-EQUAL |op| '|Record|) + (CONS |op| + (PROG (tpd8) + (SPADLET tpd8 NIL) + (RETURN + (DO ((tpd9 |argl| (CDR tpd9)) + (tpda NIL)) + ((OR (ATOM tpd9) + (PROGN + (SETQ tpda (CAR tpd9)) + NIL) + (PROGN + (PROGN + (SPADLET |sel| + (CADR tpda)) + (SPADLET |type| + (CADDR tpda)) + tpda) + NIL)) + (NREVERSE0 tpd8)) + (SEQ (EXIT + (SETQ tpd8 + (CONS + (CONS '|:| + (CONS |sel| + (CONS + (|parseTypeEvaluate| |type|) + NIL))) + tpd8))))))))) + ('T + (SPADLET |cmm| + (SEQ (COND + ((SPADLET |fn| + (|constructor?| |op|)) + (COND + ((SPADLET |p| + (|pathname| + (CONS |fn| + (CONS |$spadLibFT| + (CONS "*" NIL))))) + (EXIT + (COND + ((|isExistingFile| |p|) + (|getConstructorModemap| + (|abbreviation?| |fn|))) + ('T NIL)))))) + ('T NIL)))) + (COND + ((AND (CONSP |cmm|) + (PROGN + (SPADLET |ISTMP#1| (QCAR |cmm|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) + (PROGN + (SPADLET |argml| + (QCDR |ISTMP#2|)) + 'T)))))) + (CONS |op| + (|parseTypeEvaluateArgs| |argl| |argml|))) + ('T (|throwKeyedMsg| 'S2IL0015 (CONS |op| NIL))))))) + ('T |form|)))))) + ; ;parseTypeEvaluateArgs(argl,argml) == ; [argVal for arg in argl for md in argml for i in 1..] where argVal == @@ -1067,14 +1250,39 @@ parse ;;; *** |parseTypeEvaluateArgs| REDEFINED -(DEFUN |parseTypeEvaluateArgs| (|argl| |argml|) (PROG NIL (RETURN (SEQ (PROG (#0=#:G166576) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166583 |argl| (CDR #1#)) (|arg| NIL) (#2=#:G166584 |argml| (CDR #2#)) (|md| NIL) (|i| 1 (QSADD1 |i|))) ((OR (ATOM #1#) (PROGN (SETQ |arg| (CAR #1#)) NIL) (ATOM #2#) (PROGN (SETQ |md| (CAR #2#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (COND ((|isCategoryForm| |md| |$CategoryFrame|) (|parseTypeEvaluate| |arg|)) ((QUOTE T) |arg|)) #0#))))))))))) +(DEFUN |parseTypeEvaluateArgs| (|argl| |argml|) + (PROG () + (RETURN + (SEQ (PROG (tpdb) + (SPADLET tpdb NIL) + (RETURN + (DO ((tpdc |argl| (CDR tpdc)) (|arg| NIL) + (tpdd |argml| (CDR tpdd)) (|md| NIL) + (|i| 1 (QSADD1 |i|))) + ((OR (ATOM tpdc) + (PROGN (SETQ |arg| (CAR tpdc)) NIL) + (ATOM tpdd) + (PROGN (SETQ |md| (CAR tpdd)) NIL)) + (NREVERSE0 tpdb)) + (SEQ (EXIT (SETQ tpdb + (CONS (COND + ((|isCategoryForm| |md| + |$CategoryFrame|) + (|parseTypeEvaluate| |arg|)) + ('T |arg|)) + tpdb))))))))))) + + ; ; ;parseTypeError(x,md,i) == throwKeyedMsg("S2IP0003",[i,$op,md]) ;;; *** |parseTypeError| REDEFINED -(DEFUN |parseTypeError| (|x| |md| |i|) (|throwKeyedMsg| (QUOTE S2IP0003) (CONS |i| (CONS |$op| (CONS |md| NIL))))) +(DEFUN |parseTypeError| (|x| |md| |i|) + (|throwKeyedMsg| 'S2IP0003 (CONS |i| (CONS |$op| (CONS |md| NIL))))) + + ; ;specialModeTran form == ; form is [op,:argl] => @@ -1128,7 +1336,188 @@ parse ;;; *** |specialModeTran| REDEFINED -(DEFUN |specialModeTran| (|form|) (PROG (|op| |argl| |sop| |s0| |argKey| |numArgs| |zeroOrOne| |isDmp| |LETTMP#1| |vl| |extraDomain| |s3| |isUpOrMp| |domainPart| |argPart| |n| |polyForm|) (RETURN (SEQ (COND ((AND (CONSP |form|) (PROGN (SPADLET |op| (QCAR |form|)) (SPADLET |argl| (QCDR |form|)) (QUOTE T))) (COND ((NULL (ATOM |op|)) |form|) ((BOOT-EQUAL (SPADLET |s0| (ELT (SPADLET |sop| (PNAME |op|)) 0)) (QUOTE *)) (SPADLET |n| (|#| |sop|)) (COND ((EQL |n| 1) |form|) ((QUOTE T) (SPADLET |argKey| (ELT |sop| 1)) (SPADLET |numArgs| (SPADDIFFERENCE (|#| |argl|) (COND ((BOOT-EQUAL |argKey| (QUOTE |1|)) 1) ((QUOTE T) 0)))) (SPADLET |zeroOrOne| (OR (BOOT-EQUAL |argKey| (QUOTE |0|)) (BOOT-EQUAL |argKey| (QUOTE |1|)))) (SPADLET |isDmp| (COND ((> 10 |numArgs|) (AND (EQL |n| 6) (BOOT-EQUAL "DMP" (SUBSTRING |sop| 3 3)) |zeroOrOne|)) ((QUOTE T) (AND (EQL |n| 7) (BOOT-EQUAL "DMP" (SUBSTRING |sop| 4 3)) |zeroOrOne|)))) (COND (|isDmp| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) (SPADLET |extraDomain| |$EmptyMode|) (SPADLET |vl| |argl|)) ((QUOTE T) (SPADLET |LETTMP#1| (REVERSE |argl|)) (SPADLET |extraDomain| (CAR |LETTMP#1|)) (SPADLET |vl| (NREVERSE (CDR |LETTMP#1|))) |argl|)) (CONS (QUOTE |DistributedMultivariatePolynomial|) (CONS (CONS (QUOTE |construct|) |vl|) (CONS (|specialModeTran| |extraDomain|) NIL)))) ((AND (EQL |n| 4) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 3)) (QUOTE M)) |zeroOrOne|) (|specialModeTran| (PROGN (SPADLET |extraDomain| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) (CONS |$EmptyMode| NIL)) ((QUOTE T) NIL))) (COND ((EQL (SPADLET |n| (PARSE-INTEGER (PNAME (ELT |sop| 2)))) 1) (CONS (QUOTE |SquareMatrix|) (APPEND |argl| |extraDomain|))) ((EQL |n| 2) (CONS (QUOTE |RectangularMatrix|) (APPEND |argl| |extraDomain|))) ((QUOTE T) |form|))))) ((QUOTE T) (SPADLET |isUpOrMp| (COND ((> 10 |numArgs|) (OR (AND (EQL |n| 4) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 3)) (QUOTE P)) |zeroOrOne|) (AND (EQL |n| 5) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 3)) (QUOTE R)) (BOOT-EQUAL (ELT |sop| 4) (QUOTE F)) |zeroOrOne|))) ((QUOTE T) (OR (AND (EQL |n| 5) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 4)) (QUOTE P)) |zeroOrOne|) (AND (EQL |n| 6) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 4)) (QUOTE R)) (BOOT-EQUAL (ELT |sop| 5) (QUOTE F)) |zeroOrOne|))))) (COND (|isUpOrMp| (SPADLET |polyForm| (PROGN (SPADLET |domainPart| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) |$EmptyMode|) ((QUOTE T) (|last| |argl|)))) (SPADLET |argPart| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) |argl|) ((QUOTE T) (DROP (SPADDIFFERENCE 1) |argl|)))) (COND ((AND (> 10 |numArgs|) (EQL (SPADLET |n| (PARSE-INTEGER (PNAME (ELT |sop| 2)))) 1)) (CONS (QUOTE UP) (APPEND |argPart| (CONS |domainPart| NIL)))) ((QUOTE T) (CONS (QUOTE MP) (CONS (CONS (QUOTE |construct|) |argPart|) (CONS |domainPart| NIL))))))) (|specialModeTran| (COND ((BOOT-EQUAL |s3| (QUOTE R)) (CONS |$QuotientField| (CONS |polyForm| NIL))) ((QUOTE T) |polyForm|)))) ((QUOTE T) (CONS (CAR |form|) (PROG (#0=#:G166626) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166631 (CDR |form|) (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|specialModeTran| |x|) #0#))))))))))))))) ((QUOTE T) (CONS (CAR |form|) (PROG (#2=#:G166641) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G166646 (CDR |form|) (CDR #3#)) (|x| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |x| (CAR #3#)) NIL)) (NREVERSE0 #2#)) (SEQ (EXIT (SETQ #2# (CONS (|specialModeTran| |x|) #2#))))))))))) ((QUOTE T) |form|)))))) +(DEFUN |specialModeTran| (|form|) + (PROG (|op| |argl| |sop| |s0| |argKey| |numArgs| |zeroOrOne| |isDmp| + |LETTMP#1| |vl| |extraDomain| |s3| |isUpOrMp| + |domainPart| |argPart| |n| |polyForm|) + (RETURN + (SEQ (COND + ((AND (CONSP |form|) + (PROGN + (SPADLET |op| (QCAR |form|)) + (SPADLET |argl| (QCDR |form|)) + 'T)) + (COND + ((NULL (ATOM |op|)) |form|) + ((BOOT-EQUAL + (SPADLET |s0| + (ELT (SPADLET |sop| (PNAME |op|)) 0)) + '*) + (SPADLET |n| (|#| |sop|)) + (COND + ((EQL |n| 1) |form|) + ('T (SPADLET |argKey| (ELT |sop| 1)) + (SPADLET |numArgs| + (SPADDIFFERENCE (|#| |argl|) + (COND + ((BOOT-EQUAL |argKey| '|1|) 1) + ('T 0)))) + (SPADLET |zeroOrOne| + (OR (BOOT-EQUAL |argKey| '|0|) + (BOOT-EQUAL |argKey| '|1|))) + (SPADLET |isDmp| + (COND + ((> 10 |numArgs|) + (AND (EQL |n| 6) + (BOOT-EQUAL "DMP" + (SUBSTRING |sop| 3 3)) + |zeroOrOne|)) + ('T + (AND (EQL |n| 7) + (BOOT-EQUAL "DMP" + (SUBSTRING |sop| 4 3)) + |zeroOrOne|)))) + (COND + (|isDmp| (COND + ((BOOT-EQUAL |argKey| '|0|) + (SPADLET |extraDomain| |$EmptyMode|) + (SPADLET |vl| |argl|)) + ('T + (SPADLET |LETTMP#1| (REVERSE |argl|)) + (SPADLET |extraDomain| + (CAR |LETTMP#1|)) + (SPADLET |vl| + (NREVERSE (CDR |LETTMP#1|))) + |argl|)) + (CONS '|DistributedMultivariatePolynomial| + (CONS (CONS '|construct| |vl|) + (CONS + (|specialModeTran| + |extraDomain|) + NIL)))) + ((AND (EQL |n| 4) + (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 3)) + 'M) + |zeroOrOne|) + (|specialModeTran| + (PROGN + (SPADLET |extraDomain| + (COND + ((BOOT-EQUAL |argKey| '|0|) + (CONS |$EmptyMode| NIL)) + ('T NIL))) + (COND + ((EQL (SPADLET |n| + (PARSE-INTEGER + (PNAME (ELT |sop| 2)))) + 1) + (CONS '|SquareMatrix| + (APPEND |argl| |extraDomain|))) + ((EQL |n| 2) + (CONS '|RectangularMatrix| + (APPEND |argl| |extraDomain|))) + ('T |form|))))) + ('T + (SPADLET |isUpOrMp| + (COND + ((> 10 |numArgs|) + (OR + (AND (EQL |n| 4) + (BOOT-EQUAL + (SPADLET |s3| (ELT |sop| 3)) 'P) + |zeroOrOne|) + (AND (EQL |n| 5) + (BOOT-EQUAL + (SPADLET |s3| (ELT |sop| 3)) 'R) + (BOOT-EQUAL (ELT |sop| 4) 'F) + |zeroOrOne|))) + ('T + (OR + (AND (EQL |n| 5) + (BOOT-EQUAL + (SPADLET |s3| (ELT |sop| 4)) 'P) + |zeroOrOne|) + (AND (EQL |n| 6) + (BOOT-EQUAL + (SPADLET |s3| (ELT |sop| 4)) 'R) + (BOOT-EQUAL (ELT |sop| 5) 'F) + |zeroOrOne|))))) + (COND + (|isUpOrMp| + (SPADLET |polyForm| + (PROGN + (SPADLET |domainPart| + (COND + ((BOOT-EQUAL |argKey| '|0|) + |$EmptyMode|) + ('T (|last| |argl|)))) + (SPADLET |argPart| + (COND + ((BOOT-EQUAL |argKey| '|0|) + |argl|) + ('T + (DROP (SPADDIFFERENCE 1) + |argl|)))) + (COND + ((AND (> 10 |numArgs|) + (EQL + (SPADLET |n| + (PARSE-INTEGER + (PNAME (ELT |sop| 2)))) + 1)) + (CONS 'UP + (APPEND |argPart| + (CONS |domainPart| NIL)))) + ('T + (CONS 'MP + (CONS + (CONS '|construct| + |argPart|) + (CONS |domainPart| NIL))))))) + (|specialModeTran| + (COND + ((BOOT-EQUAL |s3| 'R) + (CONS |$QuotientField| + (CONS |polyForm| NIL))) + ('T |polyForm|)))) + ('T + (CONS (CAR |form|) + (PROG (tpde) + (SPADLET tpde NIL) + (RETURN + (DO + ((tpdf (CDR |form|) + (CDR tpdf)) + (|x| NIL)) + ((OR (ATOM tpdf) + (PROGN + (SETQ |x| (CAR tpdf)) + NIL)) + (NREVERSE0 tpde)) + (SEQ + (EXIT + (SETQ tpde + (CONS (|specialModeTran| |x|) + tpde))))))))))))))) + ('T + (CONS (CAR |form|) + (PROG (tpdg) + (SPADLET tpdg NIL) + (RETURN + (DO ((tpdh (CDR |form|) + (CDR tpdh)) + (|x| NIL)) + ((OR (ATOM tpdh) + (PROGN + (SETQ |x| (CAR tpdh)) + NIL)) + (NREVERSE0 tpdg)) + (SEQ (EXIT (SETQ tpdg + (CONS (|specialModeTran| |x|) + tpdg))))))))))) + ('T |form|)))))) + + ; ; ; @@ -1142,11 +1531,50 @@ parse ;;; *** |parseCases,casefn| REDEFINED -(DEFUN |parseCases,casefn| (|x| |ifExpr|) (PROG (|ISTMP#1| |a| |ISTMP#2| |b| |ISTMP#3| |c|) (RETURN (SEQ (IF (BOOT-EQUAL |ifExpr| (QUOTE |noBranch|)) (EXIT (CONS (QUOTE |ifClauseError|) (CONS |x| NIL)))) (IF (AND (CONSP |ifExpr|) (EQ (QCAR |ifExpr|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |ifExpr|)) (AND (CONSP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (CONSP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |c| (QCAR |ISTMP#3|)) (QUOTE T))))))))) (EXIT (CONS (QUOTE IF) (CONS (|parseTran| |a|) (CONS (|parseTran| |b|) (CONS (|parseCases,casefn| |x| |c|) NIL)))))) (EXIT (|postError| (CONS " CASES format error: cases " (CONS |x| (CONS (QUOTE | of |) (CONS |ifExpr| NIL)))))))))) +(DEFUN |parseCases,casefn| (|x| |ifExpr|) + (PROG (|ISTMP#1| |a| |ISTMP#2| |b| |ISTMP#3| |c|) + (RETURN + (SEQ (IF (BOOT-EQUAL |ifExpr| '|noBranch|) + (EXIT (CONS '|ifClauseError| (CONS |x| NIL)))) + (IF (AND (CONSP |ifExpr|) (EQ (QCAR |ifExpr|) 'IF) + (PROGN + (SPADLET |ISTMP#1| (QCDR |ifExpr|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SPADLET |a| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) + (PROGN + (SPADLET |b| (QCAR |ISTMP#2|)) + (SPADLET |ISTMP#3| + (QCDR |ISTMP#2|)) + (AND (CONSP |ISTMP#3|) + (EQ (QCDR |ISTMP#3|) NIL) + (PROGN + (SPADLET |c| (QCAR |ISTMP#3|)) + 'T)))))))) + (EXIT (CONS 'IF + (CONS (|parseTran| |a|) + (CONS (|parseTran| |b|) + (CONS + (|parseCases,casefn| |x| |c|) + NIL)))))) + (EXIT (|postError| + (CONS " CASES format error: cases " + (CONS |x| + (CONS '| of | (CONS |ifExpr| NIL)))))))))) + ;;; *** |parseCases| REDEFINED -(DEFUN |parseCases| (#0=#:G167006) (PROG (|expr| |ifClause|) (RETURN (PROGN (SPADLET |expr| (CAR #0#)) (SPADLET |ifClause| (CADR #0#)) (|parseCases,casefn| |expr| |ifClause|))))) +(DEFUN |parseCases| (arg) + (PROG (|expr| |ifClause|) + (RETURN + (PROGN + (SPADLET |expr| (CAR arg)) + (SPADLET |ifClause| (CADR arg)) + (|parseCases,casefn| |expr| |ifClause|))))) + ; ; ; @@ -1183,7 +1611,241 @@ parse ;;; *** |transSeq| REDEFINED -(DEFUN |transSeq| (|l|) (PROG (|item| |tail| |ISTMP#7| |p| |ISTMP#8| |ISTMP#9| |ISTMP#10| |ISTMP#11| |q| |ISTMP#12| |a| |ISTMP#2| |ISTMP#3| |ISTMP#4| |ISTMP#5| |ISTMP#6| |b| |y| |ISTMP#1| |s|) (RETURN (SEQ (COND ((NULL |l|) NIL) ((NULL (CDR |l|)) (|decExitLevel| (CAR |l|))) ((QUOTE T) (SPADLET |item| (CAR |l|)) (SPADLET |tail| (CDR |l|)) (COND ((AND (CONSP |item|) (EQ (QCAR |item|) (QUOTE SEQ)) (PROGN (SPADLET |ISTMP#1| (QCDR |item|)) (AND (CONSP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (CONSP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (CONSP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (CONSP |ISTMP#4|) (EQUAL (QCAR |ISTMP#4|) 1) (PROGN (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (CONSP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |ISTMP#6| (QCAR |ISTMP#5|)) (AND (CONSP |ISTMP#6|) (EQ (QCAR |ISTMP#6|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#7| (QCDR |ISTMP#6|)) (AND (CONSP |ISTMP#7|) (PROGN (SPADLET |p| (QCAR |ISTMP#7|)) (SPADLET |ISTMP#8| (QCDR |ISTMP#7|)) (AND (CONSP |ISTMP#8|) (PROGN (SPADLET |ISTMP#9| (QCAR |ISTMP#8|)) (AND (CONSP |ISTMP#9|) (EQ (QCAR |ISTMP#9|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#10| (QCDR |ISTMP#9|)) (AND (CONSP |ISTMP#10|) (EQUAL (QCAR |ISTMP#10|) 2) (PROGN (SPADLET |ISTMP#11| (QCDR |ISTMP#10|)) (AND (CONSP |ISTMP#11|) (EQ (QCDR |ISTMP#11|) NIL) (PROGN (SPADLET |q| (QCAR |ISTMP#11|)) (QUOTE T)))))))) (PROGN (SPADLET |ISTMP#12| (QCDR |ISTMP#8|)) (AND (CONSP |ISTMP#12|) (EQ (QCDR |ISTMP#12|) NIL) (EQ (QCAR |ISTMP#12|) (QUOTE |noBranch|)))))))))))))))) (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T)))) (PROG (#0=#:G168041) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G168047 NIL (NULL #0#)) (#2=#:G168048 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (AND (CONSP |x|) (EQ (QCAR |x|) (QUOTE LET))))))))))) (CONS (QUOTE SEQ) (APPEND (PROG (#3=#:G168059) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G168064 |l| (CDR #4#)) (|x| NIL)) ((OR (ATOM #4#) (PROGN (SETQ |x| (CAR #4#)) NIL)) (NREVERSE0 #3#)) (SEQ (EXIT (SETQ #3# (CONS (|decExitLevel| |x|) #3#))))))) (CONS (CONS (QUOTE |exit|) (CONS 1 (CONS (CONS (QUOTE IF) (CONS (|decExitLevel| |p|) (CONS (|decExitLevel| |q|) (CONS (|transSeq| |tail|) NIL)))) NIL))) NIL)))) ((AND (CONSP |item|) (EQ (QCAR |item|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |item|)) (AND (CONSP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (CONSP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (CONSP |ISTMP#4|) (EQUAL (QCAR |ISTMP#4|) 1) (PROGN (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (CONSP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#5|)) (QUOTE T)))))))) (PROGN (SPADLET |ISTMP#6| (QCDR |ISTMP#2|)) (AND (CONSP |ISTMP#6|) (EQ (QCDR |ISTMP#6|) NIL) (EQ (QCAR |ISTMP#6|) (QUOTE |noBranch|))))))))) (CONS (QUOTE IF) (CONS (|decExitLevel| |a|) (CONS (|decExitLevel| |b|) (CONS (|transSeq| |tail|) NIL))))) ((AND (CONSP |item|) (EQ (QCAR |item|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |item|)) (AND (CONSP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (EQ (QCAR |ISTMP#2|) (QUOTE |noBranch|)) (PROGN (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (CONSP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |ISTMP#4| (QCAR |ISTMP#3|)) (AND (CONSP |ISTMP#4|) (EQ (QCAR |ISTMP#4|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (CONSP |ISTMP#5|) (EQUAL (QCAR |ISTMP#5|) 1) (PROGN (SPADLET |ISTMP#6| (QCDR |ISTMP#5|)) (AND (CONSP |ISTMP#6|) (EQ (QCDR |ISTMP#6|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#6|)) (QUOTE T))))))))))))))) (CONS (QUOTE IF) (CONS (|decExitLevel| |a|) (CONS (|transSeq| |tail|) (CONS (|decExitLevel| |b|) NIL))))) ((PROGN (SPADLET |ISTMP#1| (SPADLET |y| (|transSeq| |tail|))) (AND (CONSP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE SEQ)) (PROGN (SPADLET |s| (QCDR |ISTMP#1|)) (QUOTE T)))) (CONS (QUOTE SEQ) (CONS |item| |s|))) ((QUOTE T) (CONS (QUOTE SEQ) (CONS |item| (CONS (CONS (QUOTE |exit|) (CONS 1 (CONS (|incExitLevel| |y|) NIL))) NIL))))))))))) +(DEFUN |transSeq| (|l|) + (PROG (|item| |tail| |ISTMP#7| |p| |ISTMP#8| |ISTMP#9| |ISTMP#10| + |ISTMP#11| |q| |ISTMP#12| |a| |ISTMP#2| |ISTMP#3| + |ISTMP#4| |ISTMP#5| |ISTMP#6| |b| |y| |ISTMP#1| |s|) + (RETURN + (SEQ (COND + ((NULL |l|) NIL) + ((NULL (CDR |l|)) (|decExitLevel| (CAR |l|))) + ('T (SPADLET |item| (CAR |l|)) (SPADLET |tail| (CDR |l|)) + (COND + ((AND (CONSP |item|) (EQ (QCAR |item|) 'SEQ) + (PROGN + (SPADLET |ISTMP#1| (QCDR |item|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) + 'T) + (CONSP |ISTMP#2|) + (PROGN + (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) + (AND (CONSP |ISTMP#3|) + (EQ (QCAR |ISTMP#3|) '|exit|) + (PROGN + (SPADLET |ISTMP#4| + (QCDR |ISTMP#3|)) + (AND (CONSP |ISTMP#4|) + (EQUAL (QCAR |ISTMP#4|) 1) + (PROGN + (SPADLET |ISTMP#5| + (QCDR |ISTMP#4|)) + (AND (CONSP |ISTMP#5|) + (EQ (QCDR |ISTMP#5|) NIL) + (PROGN + (SPADLET |ISTMP#6| + (QCAR |ISTMP#5|)) + (AND (CONSP |ISTMP#6|) + (EQ (QCAR |ISTMP#6|) 'IF) + (PROGN + (SPADLET |ISTMP#7| + (QCDR |ISTMP#6|)) + (AND (CONSP |ISTMP#7|) + (PROGN + (SPADLET |p| + (QCAR |ISTMP#7|)) + (SPADLET |ISTMP#8| + (QCDR |ISTMP#7|)) + (AND + (CONSP |ISTMP#8|) + (PROGN + (SPADLET |ISTMP#9| + (QCAR |ISTMP#8|)) + (AND + (CONSP |ISTMP#9|) + (EQ + (QCAR |ISTMP#9|) + '|exit|) + (PROGN + (SPADLET + |ISTMP#10| + (QCDR + |ISTMP#9|)) + (AND + (CONSP + |ISTMP#10|) + (EQUAL + (QCAR + |ISTMP#10|) + 2) + (PROGN + (SPADLET + |ISTMP#11| + (QCDR + |ISTMP#10|)) + (AND + (CONSP + |ISTMP#11|) + (EQ + (QCDR + |ISTMP#11|) + NIL) + (PROGN + (SPADLET + |q| + (QCAR + |ISTMP#11|)) + 'T))))))) + (PROGN + (SPADLET + |ISTMP#12| + (QCDR |ISTMP#8|)) + (AND + (CONSP + |ISTMP#12|) + (EQ + (QCDR + |ISTMP#12|) + NIL) + (EQ + (QCAR + |ISTMP#12|) + '|noBranch|))))))))))))))) + (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) 'T) + (PROGN (SPADLET |l| (NREVERSE |l|)) 'T))) + (PROG (tpdj) + (SPADLET tpdj 'T) + (RETURN + (DO ((tpdk NIL (NULL tpdj)) + (tpdl |l| (CDR tpdl)) + (|x| NIL)) + ((OR tpdk (ATOM tpdl) + (PROGN + (SETQ |x| (CAR tpdl)) + NIL)) + tpdj) + (SEQ (EXIT (SETQ tpdj + (AND tpdj + (AND (CONSP |x|) + (EQ (QCAR |x|) 'LET)))))))))) + (CONS 'SEQ + (APPEND (PROG (tpdm) + (SPADLET tpdm NIL) + (RETURN + (DO + ((tpdn |l| (CDR tpdn)) + (|x| NIL)) + ((OR (ATOM tpdn) + (PROGN + (SETQ |x| (CAR tpdn)) + NIL)) + (NREVERSE0 tpdm)) + (SEQ + (EXIT + (SETQ tpdm + (CONS (|decExitLevel| |x|) + tpdm))))))) + (CONS (CONS '|exit| + (CONS 1 + (CONS + (CONS 'IF + (CONS (|decExitLevel| |p|) + (CONS (|decExitLevel| |q|) + (CONS (|transSeq| |tail|) + NIL)))) + NIL))) + NIL)))) + ((AND (CONSP |item|) (EQ (QCAR |item|) 'IF) + (PROGN + (SPADLET |ISTMP#1| (QCDR |item|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SPADLET |a| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) + (PROGN + (SPADLET |ISTMP#3| + (QCAR |ISTMP#2|)) + (AND (CONSP |ISTMP#3|) + (EQ (QCAR |ISTMP#3|) '|exit|) + (PROGN + (SPADLET |ISTMP#4| + (QCDR |ISTMP#3|)) + (AND (CONSP |ISTMP#4|) + (EQUAL (QCAR |ISTMP#4|) 1) + (PROGN + (SPADLET |ISTMP#5| + (QCDR |ISTMP#4|)) + (AND (CONSP |ISTMP#5|) + (EQ (QCDR |ISTMP#5|) NIL) + (PROGN + (SPADLET |b| + (QCAR |ISTMP#5|)) + 'T))))))) + (PROGN + (SPADLET |ISTMP#6| + (QCDR |ISTMP#2|)) + (AND (CONSP |ISTMP#6|) + (EQ (QCDR |ISTMP#6|) NIL) + (EQ (QCAR |ISTMP#6|) + '|noBranch|)))))))) + (CONS 'IF + (CONS (|decExitLevel| |a|) + (CONS (|decExitLevel| |b|) + (CONS (|transSeq| |tail|) NIL))))) + ((AND (CONSP |item|) (EQ (QCAR |item|) 'IF) + (PROGN + (SPADLET |ISTMP#1| (QCDR |item|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SPADLET |a| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) + (EQ (QCAR |ISTMP#2|) '|noBranch|) + (PROGN + (SPADLET |ISTMP#3| + (QCDR |ISTMP#2|)) + (AND (CONSP |ISTMP#3|) + (EQ (QCDR |ISTMP#3|) NIL) + (PROGN + (SPADLET |ISTMP#4| + (QCAR |ISTMP#3|)) + (AND (CONSP |ISTMP#4|) + (EQ (QCAR |ISTMP#4|) '|exit|) + (PROGN + (SPADLET |ISTMP#5| + (QCDR |ISTMP#4|)) + (AND (CONSP |ISTMP#5|) + (EQUAL (QCAR |ISTMP#5|) 1) + (PROGN + (SPADLET |ISTMP#6| + (QCDR |ISTMP#5|)) + (AND (CONSP |ISTMP#6|) + (EQ (QCDR |ISTMP#6|) + NIL) + (PROGN + (SPADLET |b| + (QCAR |ISTMP#6|)) + 'T)))))))))))))) + (CONS 'IF + (CONS (|decExitLevel| |a|) + (CONS (|transSeq| |tail|) + (CONS (|decExitLevel| |b|) NIL))))) + ((PROGN + (SPADLET |ISTMP#1| + (SPADLET |y| (|transSeq| |tail|))) + (AND (CONSP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) 'SEQ) + (PROGN (SPADLET |s| (QCDR |ISTMP#1|)) 'T))) + (CONS 'SEQ (CONS |item| |s|))) + ('T + (CONS 'SEQ + (CONS |item| + (CONS (CONS '|exit| + (CONS 1 + (CONS (|incExitLevel| |y|) NIL))) + NIL))))))))))) + ; ;transCategoryItem x == ; x is ['SIGNATURE,lhs,rhs] => @@ -1207,7 +1869,78 @@ parse ;;; *** |transCategoryItem| REDEFINED -(DEFUN |transCategoryItem| (|x|) (PROG (|ISTMP#2| |y| |lhs| |ISTMP#1| |op| |argl| |m| |extra| |rhs|) (RETURN (SEQ (COND ((AND (CONSP |x|) (EQ (QCAR |x|) (QUOTE SIGNATURE)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (CONSP |ISTMP#1|) (PROGN (SPADLET |lhs| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |rhs| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((AND (CONSP |lhs|) (EQ (QCAR |lhs|) (QUOTE LISTOF)) (PROGN (SPADLET |y| (QCDR |lhs|)) (QUOTE T))) (PROG (#0=#:G168138) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G168143 |y| (CDR #1#)) (|z| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |z| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (APPEND #0# (|transCategoryItem| (CONS (QUOTE SIGNATURE) (CONS |z| (CONS |rhs| NIL)))))))))))) ((ATOM |lhs|) (COND ((STRINGP |lhs|) (SPADLET |lhs| (INTERN |lhs|)))) (COND ((AND (CONSP |rhs|) (EQ (QCAR |rhs|) (QUOTE |Mapping|)) (PROGN (SPADLET |m| (QCDR |rhs|)) (QUOTE T))) (COND ((AND (CONSP |m|) (PROGN (SPADLET |ISTMP#1| (QCDR |m|)) (AND (CONSP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (EQ (QCAR |ISTMP#1|) (QUOTE |constant|))))) (LIST (CONS (QUOTE SIGNATURE) (CONS |lhs| (CONS (CONS (CAR |m|) NIL) (CONS (QUOTE |constant|) NIL)))))) ((QUOTE T) (LIST (CONS (QUOTE SIGNATURE) (CONS |lhs| (CONS |m| NIL))))))) ((QUOTE T) (SPADLET |$transCategoryAssoc| (CONS (CONS |lhs| |rhs|) |$transCategoryAssoc|)) NIL))) ((QUOTE T) (SPADLET |op| (CAR |lhs|)) (SPADLET |argl| (CDR |lhs|)) (SPADLET |extra| NIL) (COND ((AND (CONSP |rhs|) (EQ (QCAR |rhs|) (QUOTE |Mapping|)) (PROGN (SPADLET |m| (QCDR |rhs|)) (QUOTE T))) (COND ((CDR |m|) (SPADLET |extra| (CDR |m|)))) (SPADLET |rhs| (CAR |m|)))) (LIST (CONS (QUOTE SIGNATURE) (CONS |op| (CONS (CONS |rhs| (SUBLIS |$transCategoryAssoc| |argl|)) |extra|))))))) ((QUOTE T) (LIST |x|))))))) +(DEFUN |transCategoryItem| (|x|) + (PROG (|ISTMP#2| |y| |lhs| |ISTMP#1| |op| |argl| |m| |extra| |rhs|) + (RETURN + (SEQ (COND + ((AND (CONSP |x|) (EQ (QCAR |x|) 'SIGNATURE) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SPADLET |lhs| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |rhs| (QCAR |ISTMP#2|)) + 'T)))))) + (COND + ((AND (CONSP |lhs|) (EQ (QCAR |lhs|) 'LISTOF) + (PROGN (SPADLET |y| (QCDR |lhs|)) 'T)) + (PROG (tpdo) + (SPADLET tpdo NIL) + (RETURN + (DO ((tpdp |y| (CDR tpdp)) (|z| NIL)) + ((OR (ATOM tpdp) + (PROGN (SETQ |z| (CAR tpdp)) NIL)) + tpdo) + (SEQ (EXIT (SETQ tpdo + (APPEND tpdo + (|transCategoryItem| + (CONS 'SIGNATURE + (CONS |z| (CONS |rhs| NIL)))))))))))) + ((ATOM |lhs|) + (COND + ((STRINGP |lhs|) (SPADLET |lhs| (INTERN |lhs|)))) + (COND + ((AND (CONSP |rhs|) (EQ (QCAR |rhs|) '|Mapping|) + (PROGN (SPADLET |m| (QCDR |rhs|)) 'T)) + (COND + ((AND (CONSP |m|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |m|)) + (AND (CONSP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (EQ (QCAR |ISTMP#1|) '|constant|)))) + (LIST (CONS 'SIGNATURE + (CONS |lhs| + (CONS (CONS (CAR |m|) NIL) + (CONS '|constant| NIL)))))) + ('T + (LIST (CONS 'SIGNATURE + (CONS |lhs| (CONS |m| NIL))))))) + ('T + (SPADLET |$transCategoryAssoc| + (CONS (CONS |lhs| |rhs|) + |$transCategoryAssoc|)) + NIL))) + ('T (SPADLET |op| (CAR |lhs|)) + (SPADLET |argl| (CDR |lhs|)) (SPADLET |extra| NIL) + (COND + ((AND (CONSP |rhs|) (EQ (QCAR |rhs|) '|Mapping|) + (PROGN (SPADLET |m| (QCDR |rhs|)) 'T)) + (COND ((CDR |m|) (SPADLET |extra| (CDR |m|)))) + (SPADLET |rhs| (CAR |m|)))) + (LIST (CONS 'SIGNATURE + (CONS |op| + (CONS + (CONS |rhs| + (SUBLIS |$transCategoryAssoc| + |argl|)) + |extra|))))))) + ('T (LIST |x|))))))) + ; ;superSub(name,x) == ; for u in x repeat y:= [:y,:u] @@ -1218,7 +1951,31 @@ parse ;;; *** |superSub| REDEFINED -(DEFUN |superSub| (|name| |x|) (PROG (|y| |ISTMP#1| |u| |code|) (RETURN (SEQ (PROGN (DO ((#0=#:G168177 |x| (CDR #0#)) (|u| NIL)) ((OR (ATOM #0#) (PROGN (SETQ |u| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (SPADLET |y| (APPEND |y| |u|))))) (SPADLET |code| (COND ((AND (CONSP |x|) (EQ (QCDR |x|) NIL) (PROGN (SPADLET |ISTMP#1| (QCAR |x|)) (AND (CONSP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |u| (QCAR |ISTMP#1|)) (QUOTE T))))) |$quadSymbol|) ((QUOTE T) (STRCONC (QUOTE |(|) (|scriptTranRow| (CAR |x|)) (|scriptTran| (CDR |x|)) (QUOTE |)|))))) (CONS (INTERNL (PNAME |name|) (QUOTE $) |code|) |y|)))))) +(DEFUN |superSub| (|name| |x|) + (PROG (|y| |ISTMP#1| |u| |code|) + (RETURN + (SEQ (PROGN + (DO ((tpdq |x| (CDR tpdq)) (|u| NIL)) + ((OR (ATOM tpdq) + (PROGN (SETQ |u| (CAR tpdq)) NIL)) + NIL) + (SEQ (EXIT (SPADLET |y| (APPEND |y| |u|))))) + (SPADLET |code| + (COND + ((AND (CONSP |x|) (EQ (QCDR |x|) NIL) + (PROGN + (SPADLET |ISTMP#1| (QCAR |x|)) + (AND (CONSP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |u| (QCAR |ISTMP#1|)) + 'T)))) + |$quadSymbol|) + ('T + (STRCONC '|(| (|scriptTranRow| (CAR |x|)) + (|scriptTran| (CDR |x|)) '|)|)))) + (CONS (INTERNL (PNAME |name|) '$ |code|) |y|)))))) + ; ;scriptTran x == ; null x => "" @@ -1226,7 +1983,13 @@ parse ;;; *** |scriptTran| REDEFINED -(DEFUN |scriptTran| (|x|) (COND ((NULL |x|) (QUOTE ||)) ((QUOTE T) (STRCONC (QUOTE |;|) (|scriptTranRow| (CAR |x|)) (|scriptTran| (CDR |x|)))))) +(DEFUN |scriptTran| (|x|) + (COND + ((NULL |x|) '||) + ('T + (STRCONC '|;| (|scriptTranRow| (CAR |x|)) + (|scriptTran| (CDR |x|)))))) + ; ;scriptTranRow x == ; null x => "" @@ -1234,7 +1997,11 @@ parse ;;; *** |scriptTranRow| REDEFINED -(DEFUN |scriptTranRow| (|x|) (COND ((NULL |x|) (QUOTE ||)) ((QUOTE T) (STRCONC |$quadSymbol| (|scriptTranRow1| (CDR |x|)))))) +(DEFUN |scriptTranRow| (|x|) + (COND + ((NULL |x|) '||) + ('T (STRCONC |$quadSymbol| (|scriptTranRow1| (CDR |x|)))))) + ; ;scriptTranRow1 x == ; null x => "" @@ -1242,7 +2009,11 @@ parse ;;; *** |scriptTranRow1| REDEFINED -(DEFUN |scriptTranRow1| (|x|) (COND ((NULL |x|) (QUOTE ||)) ((QUOTE T) (STRCONC (QUOTE |,|) |$quadSymbol| (|scriptTranRow1| (CDR |x|)))))) +(DEFUN |scriptTranRow1| (|x|) + (COND + ((NULL |x|) '||) + ('T (STRCONC '|,| |$quadSymbol| (|scriptTranRow1| (CDR |x|)))))) + ; ;;;Boot translation finished for parse.boot