diff --git a/changelog b/changelog index da9e9c6..e99ba50 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,12 @@ +20091105 tpd src/axiom-website/patches.html 20091105.03.tpd.patch +20091105 tpd src/interp/vmlisp.lisp fix Tuple in compiles +20091105 tpd src/interp/postprop.lisp fix Tuple in compiles +20091105 tpd src/interp/parsing.lisp fix Tuple in compiles +20091105 tpd src/interp/nrunopt.lisp fix Tuple in compiles +20091105 tpd src/interp/nruncomp.lisp fix Tuple in compiles +20091105 tpd src/interp/fnewmeta.lisp fix Tuple in compiles +20091105 tpd src/interp/define.lisp fix Tuple in compiles +20091105 tpd src/interp/compiler.lisp fix Tuple in compiles 20091105 tpd src/axiom-website/patches.html 20091105.02.tpd.patch 20091105 tpd src/interp/astr.lisp removed 20091105 tpd books/bookvol5 merge astr.lisp diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index ae4d6d8..53cbfeb 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2233,5 +2233,7 @@ src/interp/int-top.lisp removed
books/bookvol5 partial merge of ptrees
20091105.02.tpd.patch books/bookvol5 merge, remove of astr
+20091105.03.tpd.patch +fix Tuple in compiles
diff --git a/src/interp/compiler.lisp.pamphlet b/src/interp/compiler.lisp.pamphlet index a9263be..8d3cb4c 100644 --- a/src/interp/compiler.lisp.pamphlet +++ b/src/interp/compiler.lisp.pamphlet @@ -645,7 +645,7 @@ from the compiler stack {\tt \$compStack} and 'T)))))) (SPADLET |args| (COND - ((AND (PAIRP |args|) (EQ (QCAR |args|) '|Tuple|) + ((AND (PAIRP |args|) (EQ (QCAR |args|) '|@Tuple|) (PROGN (SPADLET |a1| (QCDR |args|)) 'T)) |a1|) ('T |args|))) @@ -979,7 +979,7 @@ from the compiler stack {\tt \$compStack} and (SPADLET |vl| (COND ((AND (PAIRP |vl|) - (EQ (QCAR |vl|) '|Tuple|) + (EQ (QCAR |vl|) '|@Tuple|) (PROGN (SPADLET |vl1| (QCDR |vl|)) 'T)) @@ -2952,7 +2952,7 @@ Compile setq (COND ((BOOT-EQUAL |op| 'CONS) (|setqMultiple| (|uncons| |form|) |val| |m| E)) - ((BOOT-EQUAL |op| '|Tuple|) + ((BOOT-EQUAL |op| '|@Tuple|) (|setqMultiple| |l| |val| |m| E)) ('T (|setqSetelt| |form| |val| |m| E)))))))) @@ -3275,7 +3275,7 @@ Compile setelt (BOOT-EQUAL |m| |$NoValueMode|)) (|setqMultipleExplicit| |nameList| (|uncons| |val|) |m| |e|)) - ((AND (PAIRP |val|) (EQ (QCAR |val|) '|Tuple|) + ((AND (PAIRP |val|) (EQ (QCAR |val|) '|@Tuple|) (PROGN (SPADLET |l| (QCDR |val|)) 'T) (BOOT-EQUAL |m| |$NoValueMode|)) (|setqMultipleExplicit| |nameList| |l| |m| |e|)) diff --git a/src/interp/define.lisp.pamphlet b/src/interp/define.lisp.pamphlet index 9672d31..30f179c 100644 --- a/src/interp/define.lisp.pamphlet +++ b/src/interp/define.lisp.pamphlet @@ -5107,7 +5107,7 @@ ((BOOT-EQUAL |$bootStrapMode| 'T) (COND ((AND (PAIRP |$addForm|) - (EQ (QCAR |$addForm|) '|Tuple|)) + (EQ (QCAR |$addForm|) '|@Tuple|)) (SPADLET |code| NIL)) ('T (SPADLET |LETTMP#1| (|comp| |$addForm| |m| |e|)) (SPADLET |code| (CAR |LETTMP#1|)) @@ -5172,7 +5172,7 @@ (SPADLET |$packagesUsed| (COND ((AND (PAIRP |$addForm|) - (EQ (QCAR |$addForm|) '|Tuple|) + (EQ (QCAR |$addForm|) '|@Tuple|) (PROGN (SPADLET |u| (QCDR |$addForm|)) 'T)) @@ -5182,9 +5182,9 @@ (SPADLET |LETTMP#1| (COND ((AND (PAIRP |$addForm|) - (EQ (QCAR |$addForm|) '|Tuple|)) + (EQ (QCAR |$addForm|) '|@Tuple|)) (SPADLET |$NRTaddForm| - (CONS '|Tuple| + (CONS '|@Tuple| (PROG (G169653) (SPADLET G169653 NIL) (RETURN diff --git a/src/interp/fnewmeta.lisp.pamphlet b/src/interp/fnewmeta.lisp.pamphlet index 29c55dd..8bfbe0e 100644 --- a/src/interp/fnewmeta.lisp.pamphlet +++ b/src/interp/fnewmeta.lisp.pamphlet @@ -194,7 +194,7 @@ FloatExponent: =(AND (MEMBER (CURRENT-SYMBOL) "(E e)) /?(IDENTP (CURRENT-SYMBOL)) =(SETQ $1 (FLOATEXPID (CURRENT-SYMBOL))) .(ADVANCE-TOKEN) +=$1 ; -Enclosure: '(' ( Expr{6} ')' / ')' +(Tuple) ) +Enclosure: '(' ( Expr{6} ')' / ')' +(\@Tuple) ) / '{' ( Expr{6} '}' +(brace (construct #1)) / '}' +(brace)) ; IntegerTok: NUMBER ; @@ -812,7 +812,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (MUST (MATCH-ADVANCE-STRING ")"))) (AND (MATCH-ADVANCE-STRING ")") (PUSH-REDUCTION '|PARSE-Enclosure| - (CONS '|Tuple| NIL)))))) + (CONS '|@Tuple| NIL)))))) (AND (MATCH-ADVANCE-STRING "{") (MUST (OR (AND (|PARSE-Expr| 6) (MUST (MATCH-ADVANCE-STRING "}")) diff --git a/src/interp/nruncomp.lisp.pamphlet b/src/interp/nruncomp.lisp.pamphlet index 0fa470e..7c569bc 100644 --- a/src/interp/nruncomp.lisp.pamphlet +++ b/src/interp/nruncomp.lisp.pamphlet @@ -67,7 +67,7 @@ (|$NRTaddForm| (COND ((AND (PAIRP |$NRTaddForm|) - (EQ (QCAR |$NRTaddForm|) '|Tuple|) + (EQ (QCAR |$NRTaddForm|) '|@Tuple|) (PROGN (SPADLET |y| (QCDR |$NRTaddForm|)) 'T)) diff --git a/src/interp/nrunopt.lisp.pamphlet b/src/interp/nrunopt.lisp.pamphlet index 9b48c35..fa1d0ee 100644 --- a/src/interp/nrunopt.lisp.pamphlet +++ b/src/interp/nrunopt.lisp.pamphlet @@ -3254,7 +3254,7 @@ (PROG (|r|) (RETURN (SEQ (COND - ((AND (PAIRP |addForm|) (EQ (QCAR |addForm|) '|Tuple|) + ((AND (PAIRP |addForm|) (EQ (QCAR |addForm|) '|@Tuple|) (PROGN (SPADLET |r| (QCDR |addForm|)) 'T)) (PROG (G168278) (SPADLET G168278 'T) diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index 8ac56b3..e3128a1 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -1833,8 +1833,8 @@ foo defined inside of fum gets renamed as fum,foo.") (defun DEF-IS2 (FORM STRUCT) (let ($IS-EQLIST $IS-SPILL_LIST (FORM (DEFTRAN FORM))) - (if (EQCAR STRUCT '|Tuple|) - (MOAN "you must use square brackets around right arg. to" '%b "is" '%d)) + (if (EQCAR STRUCT '|@Tuple|) + (MOAN "you must use square brackets around right arg. to" '%b "is" '%d)) (let* ((X (DEF-IS-EQLIST (DEF-IS-REMDUP STRUCT))) (CODE (if (IDENTP X) (MKPF (SUBST FORM X $IS-EQLIST) 'AND) @@ -2911,7 +2911,7 @@ fnewmeta (MUST (MATCH-ADVANCE-STRING ")"))) (AND (MATCH-ADVANCE-STRING ")") (PUSH-REDUCTION '|PARSE-Enclosure| - (CONS '|Tuple| NIL)))))) + (CONS '|@Tuple| NIL)))))) (AND (MATCH-ADVANCE-STRING "{") (MUST (OR (AND (|PARSE-Expr| 6) (MUST (MATCH-ADVANCE-STRING "}")) @@ -4460,7 +4460,7 @@ postpar ;;; *** |postTransform| REDEFINED -(DEFUN |postTransform| (|y|) (PROG (|x| |ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |ISTMP#5| |t| |l| |u|) (RETURN (SEQ (PROGN (SPADLET |x| |y|) (SPADLET |u| (|postTran| |x|)) (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |Tuple|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (PROGN (SPADLET |y| (QCAR |ISTMP#4|)) (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |t| (QCAR |ISTMP#5|)) (QUOTE T)))))))) (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T)))) (PROG (#0=#:G166116) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G166122 NIL (NULL #0#)) (#2=#:G166123 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (IDENTP |x|))))))))) (SPADLET |u| (CONS (QUOTE |:|) (CONS (CONS (QUOTE LISTOF) (APPEND |l| (CONS |y| NIL))) (CONS |t| NIL)))))) (|postTransformCheck| |u|) (|aplTran| |u|)))))) +(DEFUN |postTransform| (|y|) (PROG (|x| |ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |ISTMP#5| |t| |l| |u|) (RETURN (SEQ (PROGN (SPADLET |x| |y|) (SPADLET |u| (|postTran| |x|)) (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |@Tuple|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (PROGN (SPADLET |y| (QCAR |ISTMP#4|)) (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |t| (QCAR |ISTMP#5|)) (QUOTE T)))))))) (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T)))) (PROG (#0=#:G166116) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G166122 NIL (NULL #0#)) (#2=#:G166123 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (IDENTP |x|))))))))) (SPADLET |u| (CONS (QUOTE |:|) (CONS (CONS (QUOTE LISTOF) (APPEND |l| (CONS |y| NIL))) (CONS |t| NIL)))))) (|postTransformCheck| |u|) (|aplTran| |u|)))))) ;displayPreCompilationErrors() == ; n:= #($postStack:= REMDUP NREVERSE $postStack) ; n=0 => nil @@ -4586,7 +4586,7 @@ postpar ;;; *** |postConstruct| REDEFINED -(DEFUN |postConstruct| (|u|) (PROG (|b| |a| |p| |ISTMP#2| |q| |l| |ISTMP#1| |y|) (RETURN (SEQ (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |construct|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#1|)) (QUOTE T))))) (SPADLET |a| (COND ((AND (PAIRP |b|) (EQ (QCAR |b|) (QUOTE |,|))) (|comma2Tuple| |b|)) ((QUOTE T) |b|))) (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |a|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |q| (QCAR |ISTMP#2|)) (QUOTE T))))))) (CONS (QUOTE |construct|) (CONS (|postTranSegment| |p| |q|) NIL))) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |Tuple|)) (PROGN (SPADLET |l| (QCDR |a|)) (QUOTE T))) (COND ((PROG (#0=#:G166378) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166388 NIL #0#) (#2=#:G166389 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (OR #0# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T)))))))))))) (|postMakeCons| |l|)) ((PROG (#3=#:G166396) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G166402 NIL #3#) (#5=#:G166403 |l| (CDR #5#)) (|x| NIL)) ((OR #4# (ATOM #5#) (PROGN (SETQ |x| (CAR #5#)) NIL)) #3#) (SEQ (EXIT (SETQ #3# (OR #3# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE SEGMENT)))))))))) (|tuple2List| |l|)) ((QUOTE T) (CONS (QUOTE |construct|) (|postTranList| |l|))))) ((QUOTE T) (CONS (QUOTE |construct|) (CONS (|postTran| |a|) NIL))))) ((QUOTE T) |u|)))))) +(DEFUN |postConstruct| (|u|) (PROG (|b| |a| |p| |ISTMP#2| |q| |l| |ISTMP#1| |y|) (RETURN (SEQ (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |construct|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#1|)) (QUOTE T))))) (SPADLET |a| (COND ((AND (PAIRP |b|) (EQ (QCAR |b|) (QUOTE |,|))) (|comma2Tuple| |b|)) ((QUOTE T) |b|))) (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |a|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |q| (QCAR |ISTMP#2|)) (QUOTE T))))))) (CONS (QUOTE |construct|) (CONS (|postTranSegment| |p| |q|) NIL))) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |@Tuple|)) (PROGN (SPADLET |l| (QCDR |a|)) (QUOTE T))) (COND ((PROG (#0=#:G166378) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166388 NIL #0#) (#2=#:G166389 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (OR #0# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T)))))))))))) (|postMakeCons| |l|)) ((PROG (#3=#:G166396) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G166402 NIL #3#) (#5=#:G166403 |l| (CDR #5#)) (|x| NIL)) ((OR #4# (ATOM #5#) (PROGN (SETQ |x| (CAR #5#)) NIL)) #3#) (SEQ (EXIT (SETQ #3# (OR #3# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE SEGMENT)))))))))) (|tuple2List| |l|)) ((QUOTE T) (CONS (QUOTE |construct|) (|postTranList| |l|))))) ((QUOTE T) (CONS (QUOTE |construct|) (CONS (|postTran| |a|) NIL))))) ((QUOTE T) |u|)))))) ;postError msg == ; BUMPERRORCOUNT 'precompilation ; xmsg:= @@ -4638,7 +4638,7 @@ postpar ;;; *** |postBlockItem| REDEFINED -(DEFUN |postBlockItem| (|x|) (PROG (|ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |y| |ISTMP#5| |t| |l|) (RETURN (SEQ (PROGN (SPADLET |x| (|postTran| |x|)) (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Tuple|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (PROGN (SPADLET |y| (QCAR |ISTMP#4|)) (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |t| (QCAR |ISTMP#5|)) (QUOTE T)))))))) (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T)))) (PROG (#0=#:G166534) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G166540 NIL (NULL #0#)) (#2=#:G166541 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (IDENTP |x|))))))))) (CONS (QUOTE |:|) (CONS (CONS (QUOTE LISTOF) (APPEND |l| (CONS |y| NIL))) (CONS |t| NIL)))) ((QUOTE T) |x|))))))) +(DEFUN |postBlockItem| (|x|) (PROG (|ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |y| |ISTMP#5| |t| |l|) (RETURN (SEQ (PROGN (SPADLET |x| (|postTran| |x|)) (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |@Tuple|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (PROGN (SPADLET |y| (QCAR |ISTMP#4|)) (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |t| (QCAR |ISTMP#5|)) (QUOTE T)))))))) (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T)))) (PROG (#0=#:G166534) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G166540 NIL (NULL #0#)) (#2=#:G166541 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (IDENTP |x|))))))))) (CONS (QUOTE |:|) (CONS (CONS (QUOTE LISTOF) (APPEND |l| (CONS |y| NIL))) (CONS |t| NIL)))) ((QUOTE T) |x|))))))) ;postCategory (u is ['CATEGORY,:l]) == ; --RDJ: ugh_ please -- someone take away need for PROGN as soon as possible ; null l => u @@ -4665,7 +4665,7 @@ postpar ;;; *** |comma2Tuple| REDEFINED -(DEFUN |comma2Tuple| (|u|) (CONS (QUOTE |Tuple|) (|postFlatten| |u| (QUOTE |,|)))) +(DEFUN |comma2Tuple| (|u|) (CONS (QUOTE |@Tuple|) (|postFlatten| |u| (QUOTE |,|)))) ;postDef [defOp,lhs,rhs] == ;--+ ; lhs is ["macro",name] => postMDef ["==>",name,rhs] @@ -4770,7 +4770,7 @@ postpar ;;; *** |postForm| REDEFINED -(DEFUN |postForm| (|u|) (PROG (|op| |argl| |argl'| |l| |numOfArgs| |op'| |x| |ISTMP#1| |ISTMP#2| |y|) (RETURN (SEQ (PROGN (SPADLET |op| (CAR |u|)) (SPADLET |argl| (CDR |u|)) (SPADLET |x| (COND ((ATOM |op|) (SPADLET |argl'| (|postTranList| |argl|)) (SPADLET |op'| (SEQ (EXIT |op|) (COND ($BOOT (EXIT |op|))) (COND ((OR (GETL |op| (QUOTE |Led|)) (GETL |op| (QUOTE |Nud|)) (BOOT-EQUAL |op| (QUOTE IN))) (EXIT |op|))) (SPADLET |numOfArgs| (COND ((AND (PAIRP |argl'|) (EQ (QCDR |argl'|) NIL) (PROGN (SPADLET |ISTMP#1| (QCAR |argl'|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |Tuple|)) (PROGN (SPADLET |l| (QCDR |ISTMP#1|)) (QUOTE T))))) (|#| |l|)) ((QUOTE T) 1))) (INTERNL (QUOTE *) (STRINGIMAGE |numOfArgs|) (PNAME |op|)))) (CONS |op'| |argl'|)) ((AND (PAIRP |op|) (EQ (QCAR |op|) (QUOTE |Scripts|))) (APPEND (|postTran| |op|) (|postTranList| |argl|))) ((QUOTE T) (SPADLET |u| (|postTranList| |u|)) (COND ((AND (PAIRP |u|) (PROGN (SPADLET |ISTMP#1| (QCAR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |Tuple|))))) (|postError| (CONS (MAKESTRING " ") (APPEND (|bright| |u|) (CONS (MAKESTRING "is illegal because tuples cannot be applied!") (CONS (QUOTE |%l|) (CONS (MAKESTRING " Did you misuse infix dot?") NIL)))))))) |u|))) (COND ((AND (PAIRP |x|) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCAR |ISTMP#2|) (QUOTE |Tuple|)) (PROGN (SPADLET |y| (QCDR |ISTMP#2|)) (QUOTE T))))))) (CONS (CAR |x|) |y|)) ((QUOTE T) |x|))))))) +(DEFUN |postForm| (|u|) (PROG (|op| |argl| |argl'| |l| |numOfArgs| |op'| |x| |ISTMP#1| |ISTMP#2| |y|) (RETURN (SEQ (PROGN (SPADLET |op| (CAR |u|)) (SPADLET |argl| (CDR |u|)) (SPADLET |x| (COND ((ATOM |op|) (SPADLET |argl'| (|postTranList| |argl|)) (SPADLET |op'| (SEQ (EXIT |op|) (COND ($BOOT (EXIT |op|))) (COND ((OR (GETL |op| (QUOTE |Led|)) (GETL |op| (QUOTE |Nud|)) (BOOT-EQUAL |op| (QUOTE IN))) (EXIT |op|))) (SPADLET |numOfArgs| (COND ((AND (PAIRP |argl'|) (EQ (QCDR |argl'|) NIL) (PROGN (SPADLET |ISTMP#1| (QCAR |argl'|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |@Tuple|)) (PROGN (SPADLET |l| (QCDR |ISTMP#1|)) (QUOTE T))))) (|#| |l|)) ((QUOTE T) 1))) (INTERNL (QUOTE *) (STRINGIMAGE |numOfArgs|) (PNAME |op|)))) (CONS |op'| |argl'|)) ((AND (PAIRP |op|) (EQ (QCAR |op|) (QUOTE |Scripts|))) (APPEND (|postTran| |op|) (|postTranList| |argl|))) ((QUOTE T) (SPADLET |u| (|postTranList| |u|)) (COND ((AND (PAIRP |u|) (PROGN (SPADLET |ISTMP#1| (QCAR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |@Tuple|))))) (|postError| (CONS (MAKESTRING " ") (APPEND (|bright| |u|) (CONS (MAKESTRING "is illegal because tuples cannot be applied!") (CONS (QUOTE |%l|) (CONS (MAKESTRING " Did you misuse infix dot?") NIL)))))))) |u|))) (COND ((AND (PAIRP |x|) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCAR |ISTMP#2|) (QUOTE |@Tuple|)) (PROGN (SPADLET |y| (QCDR |ISTMP#2|)) (QUOTE T))))))) (CONS (CAR |x|) |y|)) ((QUOTE T) |x|))))))) ;postQuote [.,a] == ['QUOTE,a] ;;; *** |postQuote| REDEFINED @@ -4809,7 +4809,7 @@ postpar ;;; *** |postTranScripts,fn| REDEFINED -(DEFUN |postTranScripts,fn| (|x|) (PROG (|y|) (RETURN (SEQ (IF (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Tuple|)) (PROGN (SPADLET |y| (QCDR |x|)) (QUOTE T))) (EXIT |y|)) (EXIT (LIST |x|)))))) +(DEFUN |postTranScripts,fn| (|x|) (PROG (|y|) (RETURN (SEQ (IF (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |@Tuple|)) (PROGN (SPADLET |y| (QCDR |x|)) (QUOTE T))) (EXIT |y|)) (EXIT (LIST |x|)))))) ;;; *** |postTranScripts| REDEFINED @@ -4848,7 +4848,7 @@ postpar ;;; *** |postJoin| REDEFINED -(DEFUN |postJoin| (#0=#:G167191) (PROG (|a| |b| |name| |l| |c| |al|) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |l| (CDDR #0#)) (SPADLET |a| (|postTran| |a|)) (SPADLET |l| (|postTranList| |l|)) (COND ((AND (PAIRP |l|) (EQ (QCDR |l|) NIL) (PROGN (SPADLET |b| (QCAR |l|)) (QUOTE T)) (PAIRP |b|) (PROGN (SPADLET |name| (QCAR |b|)) (QUOTE T)) (MEMQ |name| (QUOTE (ATTRIBUTE SIGNATURE)))) (SPADLET |l| (LIST (CONS (QUOTE CATEGORY) (CONS |b| NIL)))))) (SPADLET |al| (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |Tuple|)) (PROGN (SPADLET |c| (QCDR |a|)) (QUOTE T))) |c|) ((QUOTE T) (LIST |a|)))) (CONS (QUOTE |Join|) (APPEND |al| |l|)))))) +(DEFUN |postJoin| (#0=#:G167191) (PROG (|a| |b| |name| |l| |c| |al|) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |l| (CDDR #0#)) (SPADLET |a| (|postTran| |a|)) (SPADLET |l| (|postTranList| |l|)) (COND ((AND (PAIRP |l|) (EQ (QCDR |l|) NIL) (PROGN (SPADLET |b| (QCAR |l|)) (QUOTE T)) (PAIRP |b|) (PROGN (SPADLET |name| (QCAR |b|)) (QUOTE T)) (MEMQ |name| (QUOTE (ATTRIBUTE SIGNATURE)))) (SPADLET |l| (LIST (CONS (QUOTE CATEGORY) (CONS |b| NIL)))))) (SPADLET |al| (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |@Tuple|)) (PROGN (SPADLET |c| (QCDR |a|)) (QUOTE T))) |c|) ((QUOTE T) (LIST |a|)))) (CONS (QUOTE |Join|) (APPEND |al| |l|)))))) ;postMapping u == ; u isnt ["->",source,target] => u ; ['Mapping,postTran target,:unTuple postTran source] @@ -4898,7 +4898,7 @@ postpar ;;; *** |postCollect,finish| REDEFINED -(DEFUN |postCollect,finish| (|op| |itl| |y|) (PROG (|a| |l| |ISTMP#1| |newBody|) (RETURN (SEQ (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |y|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (QUOTE T))))) (EXIT (CONS (QUOTE REDUCE) (CONS (QUOTE |append|) (CONS 0 (CONS (CONS |op| (APPEND |itl| (CONS |a| NIL))) NIL)))))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |Tuple|)) (PROGN (SPADLET |l| (QCDR |y|)) (QUOTE T))) (EXIT (SEQ (SPADLET |newBody| (SEQ (IF (PROG (#0=#:G167314) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G167324 NIL #0#) (#2=#:G167325 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (OR #0# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T)))))))))))) (EXIT (|postMakeCons| |l|))) (IF (PROG (#3=#:G167332) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G167338 NIL #3#) (#5=#:G167339 |l| (CDR #5#)) (|x| NIL)) ((OR #4# (ATOM #5#) (PROGN (SETQ |x| (CAR #5#)) NIL)) #3#) (SEQ (EXIT (SETQ #3# (OR #3# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE SEGMENT)))))))))) (EXIT (|tuple2List| |l|))) (EXIT (CONS (QUOTE |construct|) (|postTranList| |l|))))) (EXIT (CONS (QUOTE REDUCE) (CONS (QUOTE |append|) (CONS 0 (CONS (CONS |op| (APPEND |itl| (CONS |newBody| NIL))) NIL)))))))) (EXIT (CONS |op| (APPEND |itl| (CONS |y| NIL)))))))) +(DEFUN |postCollect,finish| (|op| |itl| |y|) (PROG (|a| |l| |ISTMP#1| |newBody|) (RETURN (SEQ (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |y|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (QUOTE T))))) (EXIT (CONS (QUOTE REDUCE) (CONS (QUOTE |append|) (CONS 0 (CONS (CONS |op| (APPEND |itl| (CONS |a| NIL))) NIL)))))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |@Tuple|)) (PROGN (SPADLET |l| (QCDR |y|)) (QUOTE T))) (EXIT (SEQ (SPADLET |newBody| (SEQ (IF (PROG (#0=#:G167314) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G167324 NIL #0#) (#2=#:G167325 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (OR #0# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T)))))))))))) (EXIT (|postMakeCons| |l|))) (IF (PROG (#3=#:G167332) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G167338 NIL #3#) (#5=#:G167339 |l| (CDR #5#)) (|x| NIL)) ((OR #4# (ATOM #5#) (PROGN (SETQ |x| (CAR #5#)) NIL)) #3#) (SEQ (EXIT (SETQ #3# (OR #3# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE SEGMENT)))))))))) (EXIT (|tuple2List| |l|))) (EXIT (CONS (QUOTE |construct|) (|postTranList| |l|))))) (EXIT (CONS (QUOTE REDUCE) (CONS (QUOTE |append|) (CONS 0 (CONS (CONS |op| (APPEND |itl| (CONS |newBody| NIL))) NIL)))))))) (EXIT (CONS |op| (APPEND |itl| (CONS |y| NIL)))))))) ;;; *** |postCollect| REDEFINED @@ -4941,7 +4941,7 @@ postpar ;;; *** |postInSeq| REDEFINED -(DEFUN |postInSeq| (|seq|) (PROG (|ISTMP#1| |p| |ISTMP#2| |q| |l|) (RETURN (COND ((AND (PAIRP |seq|) (EQ (QCAR |seq|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |seq|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |q| (QCAR |ISTMP#2|)) (QUOTE T))))))) (|postTranSegment| |p| |q|)) ((AND (PAIRP |seq|) (EQ (QCAR |seq|) (QUOTE |Tuple|)) (PROGN (SPADLET |l| (QCDR |seq|)) (QUOTE T))) (|tuple2List| |l|)) ((QUOTE T) (|postTran| |seq|)))))) +(DEFUN |postInSeq| (|seq|) (PROG (|ISTMP#1| |p| |ISTMP#2| |q| |l|) (RETURN (COND ((AND (PAIRP |seq|) (EQ (QCAR |seq|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |seq|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |q| (QCAR |ISTMP#2|)) (QUOTE T))))))) (|postTranSegment| |p| |q|)) ((AND (PAIRP |seq|) (EQ (QCAR |seq|) (QUOTE |@Tuple|)) (PROGN (SPADLET |l| (QCDR |seq|)) (QUOTE T))) (|tuple2List| |l|)) ((QUOTE T) (|postTran| |seq|)))))) ;postTranSegment(p,q) == ['SEGMENT,postTran p,(q => postTran q; nil)] ;;; *** |postTranSegment| REDEFINED @@ -5044,7 +5044,7 @@ postpar ;;; *** |postTuple| REDEFINED -(DEFUN |postTuple| (|u|) (PROG (|ISTMP#1| |ISTMP#2| |a| |l|) (RETURN (COND ((AND (PAIRP |u|) (EQ (QCDR |u|) NIL) (EQ (QCAR |u|) (QUOTE |Tuple|))) |u|) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |Tuple|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (PAIRP |ISTMP#2|) (PROGN (SPADLET |a| (QCAR |ISTMP#2|)) (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T))))) (CONS (QUOTE |Tuple|) (|postTranList| (CDR |u|)))))))) +(DEFUN |postTuple| (|u|) (PROG (|ISTMP#1| |ISTMP#2| |a| |l|) (RETURN (COND ((AND (PAIRP |u|) (EQ (QCDR |u|) NIL) (EQ (QCAR |u|) (QUOTE |@Tuple|))) |u|) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |@Tuple|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (PAIRP |ISTMP#2|) (PROGN (SPADLET |a| (QCAR |ISTMP#2|)) (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T))))) (CONS (QUOTE |@Tuple|) (|postTranList| (CDR |u|)))))))) ;--u is ['Tuple,:l,a] => (--a:= postTran a; ['Tuple,:postTranList rest u]) ; --RDJ: don't understand need for above statement that is commented out ;postWhere ['where,a,b] == @@ -5112,7 +5112,7 @@ postpar ;;; *** |unTuple| REDEFINED -(DEFUN |unTuple| (|x|) (PROG (|y|) (RETURN (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Tuple|)) (PROGN (SPADLET |y| (QCDR |x|)) (QUOTE T))) |y|) ((QUOTE T) (LIST |x|)))))) +(DEFUN |unTuple| (|x|) (PROG (|y|) (RETURN (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |@Tuple|)) (PROGN (SPADLET |y| (QCDR |x|)) (QUOTE T))) |y|) ((QUOTE T) (LIST |x|)))))) ;--% APL TRANSFORMATION OF INPUT ;aplTran x == ; $BOOT => x diff --git a/src/interp/postprop.lisp.pamphlet b/src/interp/postprop.lisp.pamphlet index 0f3876d..8d7a3a9 100644 --- a/src/interp/postprop.lisp.pamphlet +++ b/src/interp/postprop.lisp.pamphlet @@ -103,7 +103,7 @@ (==> |postMDef|) (-> |postMapping|) (=> |postExit|) - (|Tuple| |postTuple|))) + (|@Tuple| |postTuple|))) (mapcar #'(lambda (x) (MAKEPROP (CAR X) '|parseTran| (CADR X))) '((\<= |parseLessEqual|) diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index 2843530..3c4c99b 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -7560,7 +7560,7 @@ o there is some code at the end of SPECEVAL BOOT that puts "up" (|==>| |postMDef|) (|->| |postMapping|) (|=>| |postExit|) - (|Tuple| |postTuple|) + (|@Tuple| |postTuple|) )) (MAKEPROP (CAR X) '|postTran| (CADR X))) (MAKEPROP 'INTEGER 'ISFUNCTION 'FIXP)