diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 799c22d..3e71eeb 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -1902,7 +1902,136 @@ of the symbol being parsed. The original list read: @ -\defplist{parseTran}{parseLeave} +\defun{parseIf,ifTran}{parseIf,ifTran} +\calls{parseIf,ifTran}{parseIf,ifTran} +\calls{parseIf,ifTran}{incExitLevel} +\calls{parseIf,ifTran}{makeSimplePredicateOrNil} +\calls{parseIf,ifTran}{incExitLevel} +\calls{parseIf,ifTran}{parseTran} +\usesdollar{parseIf,ifTran}{InteractiveMode} +<>= +(defun |parseIf,ifTran| (p a b) + (let (pp z ap bp tmp1 tmp2 tmp3 tmp4 tmp5 tmp6 val s) + (declare (special |$InteractiveMode|)) + (cond + ((and (null |$InteractiveMode|) (eq p '|true|)) + a) + ((and (null |$InteractiveMode|) (eq p '|false|)) + b) + ((and (pairp p) (eq (qcar p) '|not|) + (pairp (qcdr p)) (eq (qcdr (qcdr p)) nil)) + (|parseIf,ifTran| (second p) b a)) + ((and (pairp p) (eq (qcar p) 'if) + (progn + (setq tmp1 (qcdr p)) + (and (pairp tmp1) + (progn + (setq pp (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and (pairp tmp2) + (progn + (setq ap (qcar tmp2)) + (setq tmp3 (qcdr tmp2)) + (and (pairp tmp3) + (eq (qcdr tmp3) nil) + (progn (setq bp (qcar tmp3)) t)))))))) + (|parseIf,ifTran| pp + (|parseIf,ifTran| ap (copy a) (copy b)) + (|parseIf,ifTran| bp a b))) + ((and (pairp p) (eq (qcar p) 'seq) + (pairp (qcdr p)) (progn (setq tmp2 (reverse (qcdr p))) t) + (and (pairp tmp2) + (pairp (qcar tmp2)) + (eq (qcar (qcar tmp2)) '|exit|) + (progn + (setq tmp4 (qcdr (qcar tmp2))) + (and (pairp tmp4) + (equal (qcar tmp4) 1) + (progn + (setq tmp5 (qcdr tmp4)) + (and (pairp tmp5) + (eq (qcdr tmp5) nil) + (progn (setq pp (qcar tmp5)) t))))) + (progn (setq z (qcdr tmp2)) t)) + (progn (setq z (nreverse z)) t)) + (cons 'seq + (append z + (list + (list '|exit| 1 (|parseIf,ifTran| pp + (|incExitLevel| a) + (|incExitLevel| b))))))) + ((and (pairp a) (eq (qcar a) 'if) (pairp (qcdr a)) + (equal (qcar (qcdr a)) p) (pairp (qcdr (qcdr a))) + (pairp (qcdr (qcdr (qcdr a)))) + (eq (qcdr (qcdr (qcdr (qcdr a)))) nil)) + (list 'if p (third a) b)) + ((and (pairp b) (eq (qcar b) 'if) + (pairp (qcdr b)) (equal (qcar (qcdr b)) p) + (pairp (qcdr (qcdr b))) + (pairp (qcdr (qcdr (qcdr b)))) + (eq (qcdr (qcdr (qcdr (qcdr b)))) nil)) + (list 'if p a (fourth b))) + ((progn + (setq tmp1 (|makeSimplePredicateOrNil| p)) + (and (pairp tmp1) (eq (qcar tmp1) 'seq) + (progn + (setq tmp2 (qcdr tmp1)) + (and (and (pairp tmp2) + (progn (setq tmp3 (reverse tmp2)) t)) + (and (pairp tmp3) + (progn + (setq tmp4 (qcar tmp3)) + (and (pairp tmp4) (eq (qcar tmp4) '|exit|) + (progn + (setq tmp5 (qcdr tmp4)) + (and (pairp tmp5) (equal (qcar tmp5) 1) + (progn + (setq tmp6 (qcdr tmp5)) + (and (pairp tmp6) (eq (qcdr tmp6) nil) + (progn (setq val (qcar tmp6)) t))))))) + (progn (setq s (qcdr tmp3)) t)))))) + (setq s (nreverse s)) + (|parseTran| + (cons 'seq + (append s + (list (list '|exit| 1 (|incExitLevel| (list 'if val a b)))))))) + (t + (list 'if p a b ))))) + +@ + +\defun{parseIf}{parseIf} +\calls{parseIf}{parseIf,ifTran} +\calls{parseIf}{parseTran} +<>= +(defun |parseIf| (arg) + (let (p a b) + (if (null (and (pairp arg) (pairp (qcdr arg)) + (pairp (qcdr (qcdr arg))) (eq (qcdr (qcdr (qcdr arg))) nil))) + arg + (|parseIf,ifTran| + (|parseTran| (first arg)) + (|parseTran| (second arg)) + (|parseTran| (third arg)))))) + +@ + +\defplist{implies}{parseImplies} +<>= +(eval-when (eval load) + (setf (get '|implies| '|parseTran|) '|parseImplies|)) + +@ + +\defun{parseImplies}{parseImplies} +\calls{parseImplies}{parseIf} +<>= +(defun |parseImplies| (arg) + (|parseIf| (list (first arg) (second arg) '|true|))) + +@ + +\defplist{leave}{parseLeave} <>= (eval-when (eval load) (setf (get '|leave| '|parseTran|) '|parseLeave|)) @@ -1943,6 +2072,7 @@ of the symbol being parsed. The original list read: (|parseTran| (list '|not| (cons (msubst '> '<= |$op|) arg)))) @ + \chapter{Post Transformers} \section{Direct called postparse routines} \defun{postTransform}{postTransform} @@ -9637,6 +9767,9 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> +<> +<> <> <> <> diff --git a/changelog b/changelog index dc1542d..f8366da 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20101112 tpd src/axiom-website/patches.html 20101112.01.tpd.patch +20101112 tpd src/interp/vmlisp.lisp treeshake compiler +20101112 tpd src/interp/parsing.lisp treeshake compiler +20101112 tpd books/bookvol9 treeshake compiler 20101111 tpd src/axiom-website/patches.html 20101111.01.tpd.patch 20101111 tpd src/interp/vmlisp.lisp treeshake compiler 20101111 tpd src/interp/parsing.lisp treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 0d7b172..11558c3 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3260,6 +3260,8 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20101111.01.tpd.patch books/bookvol9 treeshake compiler
+20101112.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index 501b4e3..0e1e64f 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -1973,11 +1973,6 @@ parse (DEFUN |parseNot| (|u|) (COND (|$InteractiveMode| (CONS (QUOTE |not|) (CONS (|parseTran| (CAR |u|)) NIL))) ((QUOTE T) (|parseTran| (CONS (QUOTE IF) (CONS (CAR |u|) (QUOTE (|false| |true|)))))))) ; ; -;parseImplies [a,b] == parseIf [a,b,'true] - -;;; *** |parseImplies| REDEFINED - -(DEFUN |parseImplies| (#0=#:G167126) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CADR #0#)) (|parseIf| (CONS |a| (CONS |b| (CONS (QUOTE |true|) NIL)))))))) ; ;parseExclusiveOr [a,b] == parseIf [a,parseIf [b,:'(false true)],b] @@ -2050,30 +2045,6 @@ parse (DEFUN |parseIn| (#0=#:G167419) (PROG (|i| |n| |ISTMP#2| |ISTMP#3| |a| |ISTMP#4| |b| |ISTMP#1| |s|) (RETURN (PROGN (SPADLET |i| (CAR #0#)) (SPADLET |n| (CADR #0#)) (SPADLET |i| (|parseTran| |i|)) (SPADLET |n| (|parseTran| |n|)) (COND ((AND (PAIRP |n|) (EQ (QCAR |n|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |n|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (QUOTE T))))) (CONS (QUOTE STEP) (CONS |i| (CONS |a| (CONS 1 NIL))))) ((AND (PAIRP |n|) (EQ (QCAR |n|) (QUOTE |reverse|)) (PROGN (SPADLET |ISTMP#1| (QCDR |n|)) (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 SEGMENT)) (PROGN (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#3|)) (QUOTE T))))))))) (|postError| (CONS " You cannot reverse an infinite sequence." NIL))) ((AND (PAIRP |n|) (EQ (QCAR |n|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |n|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND (|b| (CONS (QUOTE STEP) (CONS |i| (CONS |a| (CONS 1 (CONS |b| NIL)))))) ((QUOTE T) (CONS (QUOTE STEP) (CONS |i| (CONS |a| (CONS 1 NIL))))))) ((AND (PAIRP |n|) (EQ (QCAR |n|) (QUOTE |reverse|)) (PROGN (SPADLET |ISTMP#1| (QCDR |n|)) (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 SEGMENT)) (PROGN (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (PROGN (SPADLET |a| (QCAR |ISTMP#3|)) (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (EQ (QCDR |ISTMP#4|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#4|)) (QUOTE T))))))))))) (COND (|b| (CONS (QUOTE STEP) (CONS |i| (CONS |b| (CONS (SPADDIFFERENCE 1) (CONS |a| NIL)))))) ((QUOTE T) (|postError| (CONS " You cannot reverse an infinite sequence." NIL))))) ((AND (PAIRP |n|) (EQ (QCAR |n|) (QUOTE |tails|)) (PROGN (SPADLET |ISTMP#1| (QCDR |n|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |s| (QCAR |ISTMP#1|)) (QUOTE T))))) (CONS (QUOTE ON) (CONS |i| (CONS |s| NIL)))) ((QUOTE T) (CONS (QUOTE IN) (CONS |i| (CONS |n| NIL))))))))) ; -;parseIf t == -; t isnt [p,a,b] => t -; ifTran(parseTran p,parseTran a,parseTran b) where -; ifTran(p,a,b) == -; null($InteractiveMode) and p='true => a -; null($InteractiveMode) and p='false => b -; p is ['not,p'] => ifTran(p',b,a) -; p is ['IF,p',a',b'] => ifTran(p',ifTran(a',COPY a,COPY b),ifTran(b',a,b)) -; p is ['SEQ,:l,['exit,1,p']] => -; ['SEQ,:l,['exit,1,ifTran(p',incExitLevel a,incExitLevel b)]] -; --this assumes that l has no exits -; a is ['IF, =p,a',.] => ['IF,p,a',b] -; b is ['IF, =p,.,b'] => ['IF,p,a,b'] -; makeSimplePredicateOrNil p is ['SEQ,:s,['exit,1,val]] => -; parseTran ['SEQ,:s,['exit,1,incExitLevel ['IF,val,a,b]]] -; ['IF,p,a,b] - -;;; *** |parseIf,ifTran| REDEFINED - -(DEFUN |parseIf,ifTran| (|p| |a| |b|) (PROG (|p'| |l| |a'| |b'| |ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |ISTMP#5| |ISTMP#6| |val| |s|) (RETURN (SEQ (IF (AND (NULL |$InteractiveMode|) (BOOT-EQUAL |p| (QUOTE |true|))) (EXIT |a|)) (IF (AND (NULL |$InteractiveMode|) (BOOT-EQUAL |p| (QUOTE |false|))) (EXIT |b|)) (IF (AND (PAIRP |p|) (EQ (QCAR |p|) (QUOTE |not|)) (PROGN (SPADLET |ISTMP#1| (QCDR |p|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |p'| (QCAR |ISTMP#1|)) (QUOTE T))))) (EXIT (|parseIf,ifTran| |p'| |b| |a|))) (IF (AND (PAIRP |p|) (EQ (QCAR |p|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |p|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |p'| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |a'| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |b'| (QCAR |ISTMP#3|)) (QUOTE T))))))))) (EXIT (|parseIf,ifTran| |p'| (|parseIf,ifTran| |a'| (COPY |a|) (COPY |b|)) (|parseIf,ifTran| |b'| |a| |b|)))) (IF (AND (PAIRP |p|) (EQ (QCAR |p|) (QUOTE SEQ)) (PROGN (SPADLET |ISTMP#1| (QCDR |p|)) (AND (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T))) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (EQUAL (QCAR |ISTMP#4|) 1) (PROGN (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |p'| (QCAR |ISTMP#5|)) (QUOTE T)))))))) (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T))) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T))))) (EXIT (CONS (QUOTE SEQ) (APPEND |l| (CONS (CONS (QUOTE |exit|) (CONS 1 (CONS (|parseIf,ifTran| |p'| (|incExitLevel| |a|) (|incExitLevel| |b|)) NIL))) NIL))))) (IF (AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |a|)) (AND (PAIRP |ISTMP#1|) (EQUAL (QCAR |ISTMP#1|) |p|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |a'| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL)))))))) (EXIT (CONS (QUOTE IF) (CONS |p| (CONS |a'| (CONS |b| NIL)))))) (IF (AND (PAIRP |b|) (EQ (QCAR |b|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |b|)) (AND (PAIRP |ISTMP#1|) (EQUAL (QCAR |ISTMP#1|) |p|) (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) (PROGN (SPADLET |b'| (QCAR |ISTMP#3|)) (QUOTE T))))))))) (EXIT (CONS (QUOTE IF) (CONS |p| (CONS |a| (CONS |b'| NIL)))))) (IF (PROGN (SPADLET |ISTMP#1| (|makeSimplePredicateOrNil| |p|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE SEQ)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (REVERSE |ISTMP#2|)) (QUOTE T))) (AND (PAIRP |ISTMP#3|) (PROGN (SPADLET |ISTMP#4| (QCAR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (EQ (QCAR |ISTMP#4|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQUAL (QCAR |ISTMP#5|) 1) (PROGN (SPADLET |ISTMP#6| (QCDR |ISTMP#5|)) (AND (PAIRP |ISTMP#6|) (EQ (QCDR |ISTMP#6|) NIL) (PROGN (SPADLET |val| (QCAR |ISTMP#6|)) (QUOTE T)))))))) (PROGN (SPADLET |s| (QCDR |ISTMP#3|)) (QUOTE T))) (PROGN (SPADLET |s| (NREVERSE |s|)) (QUOTE T)))))) (EXIT (|parseTran| (CONS (QUOTE SEQ) (APPEND |s| (CONS (CONS (QUOTE |exit|) (CONS 1 (CONS (|incExitLevel| (CONS (QUOTE IF) (CONS |val| (CONS |a| (CONS |b| NIL))))) NIL))) NIL)))))) (EXIT (CONS (QUOTE IF) (CONS |p| (CONS |a| (CONS |b| NIL))))))))) - -;;; *** |parseIf| REDEFINED - -(DEFUN |parseIf| (|t|) (PROG (|p| |ISTMP#1| |a| |ISTMP#2| |b|) (RETURN (COND ((NULL (AND (PAIRP |t|) (PROGN (SPADLET |p| (QCAR |t|)) (SPADLET |ISTMP#1| (QCDR |t|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T)))))))) |t|) ((QUOTE T) (|parseIf,ifTran| (|parseTran| |p|) (|parseTran| |a|) (|parseTran| |b|))))))) ; ;makeSimplePredicateOrNil p == ; isSimple p => nil diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index d14a602..a87f103 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -6813,7 +6813,7 @@ o there is some code at the end of SPECEVAL BOOT that puts "up" ; (|exit| |parseExit|) ; (|has| |parseHas|) ; (IF |parseIf|) - (|implies| |parseImplies|) +; (|implies| |parseImplies|) (IN |parseIn|) (INBY |parseInBy|) (|is| |parseIs|)