diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index e1779ab..f75a35e 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -1456,7 +1456,123 @@ always positioned ON the first character. @ -\chapter{Transformers} +\chapter{Parse Transformers} +\defun{parseTransform}{parseTransform} +\calls{parseTransform}{msubst} +\calls{parseTransform}{parseTran} +\usesdollar{parseTransform}{defOp} +<>= +(defun |parseTransform| (x) + (let (|$defOp|) + (declare (special |$defOp|)) + (setq |$defOp| nil) + (setq x (msubst '$ '% x)) ; for new compiler compatibility + (|parseTran| x))) + +@ + + +\defun{parseTran}{parseTran} +\calls{parseTran}{parseAtom} +\calls{parseTran}{parseConstruct} +\calls{parseTran}{parseTran} +\calls{parseTran}{parseTranList} +\calls{parseTran}{getl} +\usesdollar{parseTran}{op} +<>= +(defun |parseTran| (x) + (labels ( + (g (op) + (let (tmp1 tmp2 x) + (seq + (if (and (pairp op) (eq (qcar op) '|elt|) + (progn + (setq tmp1 (qcdr op)) + (and (pairp tmp1) + (progn + (setq op (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and (pairp tmp2) + (eq (qcdr tmp2) nil) + (progn (setq x (qcar tmp2)) t)))))) + (exit (g x))) + (exit op))))) + (let (|$op| argl u r fn) + (declare (special |$op|)) + (setq |$op| nil) + (if (atom x) + (|parseAtom| x) + (progn + (setq |$op| (car x)) + (setq argl (cdr x)) + (setq u (g |$op|)) + (cond + ((eq u '|construct|) + (setq r (|parseConstruct| argl)) + (if (and (pairp |$op|) (eq (qcar |$op|) '|elt|)) + (cons (|parseTran| |$op|) (cdr r)) + r)) + ((and (atom u) (setq fn (getl u '|parseTran|))) + (funcall fn argl)) + (t (cons (|parseTran| |$op|) (|parseTranList| argl))))))))) + +@ + +\defun{parseAtom}{parseAtom} +\calls{parseAtom}{parseLeave} +\usesdollar{parseAtom}{NoValue} +<>= +(defun |parseAtom| (x) + (declare (special |$NoValue|)) + (if (eq x '|break|) + (|parseLeave| (list '|$NoValue|)) + x)) + +@ + +\defun{parseTranList}{parseTranList} +\calls{parseTranList}{parseTran} +\calls{parseTranList}{parseTranList} +<>= +(defun |parseTranList| (x) + (if (atom x) + (|parseTran| x) + (cons (|parseTran| (car x)) (|parseTranList| (cdr x))))) + +@ + +\defun{parseConstruct}{parseConstruct} +\calls{parseConstruct}{parseTranList} +\usesdollar{parseConstruct}{insideConstructIfTrue} +<>= +(defun |parseConstruct| (u) + (let (|$insideConstructIfTrue| x) + (declare (special |$insideConstructIfTrue|)) + (setq |$insideConstructIfTrue| t) + (setq x (|parseTranList| u)) + (cons '|construct| x))) + +@ + +\defun{parseLeave}{parseLeave} +\calls{parseLeave}{parseTran} +<>= +(defun |parseLeave| (arg) + (let (a b) + (setq a (|parseTran| (car arg))) + (setq b (|parseTran| (cdr arg))) + (cond + (b + (cond + ((null (integerp a)) + (moan "first arg " a " for 'leave' must be integer") + (list '|leave| 1 a)) + (t (list '|leave| (cons a b))))) + (t (list '|leave| 1 a))))) + +@ + +\chapter{Post Transformers} \defun{postTransform}{postTransform} \calls{postTransform}{postTran} \calls{postTransform}{identp} @@ -1656,6 +1772,59 @@ always positioned ON the first character. @ +\defun{postForm}{postForm} +\calls{postForm}{postTranList} +\calls{postForm}{internl} +\calls{postForm}{postTran} +\calls{postForm}{postError} +\calls{postForm}{bright} +\usesdollar{postForm}{boot} +<>= +;(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 " " (APPEND (|bright| |u|) (CONS "is illegal because tuples cannot be applied!" (CONS (QUOTE |%l|) (CONS " 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) + (let (op argl arglp z numOfArgs opp x) + (declare (special $boot)) + (seq + (setq op (car u)) + (setq argl (cdr u)) + (setq x + (cond + ((atom op) + (setq arglp (|postTranList| argl)) + (setq opp + (seq + (exit op) + (when $boot (exit op)) + (when (or (getl op '|Led|) (getl op '|Nud|) (eq op 'in)) (exit op)) + (setq numOfArgs + (cond + ((and (pairp arglp) (eq (qcdr arglp) nil) (pairp (qcar arglp)) + (eq (qcar (qcar arglp)) '|@Tuple|)) + (|#| (qcdr (qcar arglp)))) + (t 1))) + (internl '* (stringimage numOfArgs) (pname op)))) + (cons opp arglp)) + ((and (pairp op) (eq (qcar op) '|Scripts|)) + (append (|postTran| op) (|postTranList| argl))) + (t + (setq u (|postTranList| u)) + (cond + ((and (pairp u) (pairp (qcar u)) (eq (qcar (qcar u)) '|@Tuple|)) + (|postError| + (cons " " + (append (|bright| u) + (list "is illegal because tuples cannot be applied!" '|%l| + " Did you misuse infix dot?")))))) + u))) + (cond + ((and (pairp x) (pairp (qcdr x)) (eq (qcdr (qcdr x)) nil) + (pairp (qcar (qcdr x))) (eq (qcar (qcar (qcdr x))) '|@Tuple|)) + (cons (car x) (qcdr (qcar (qcdr x))))) + (t x))))) + +@ + \defun{setDefOp}{setDefOp} \usesdollar{setDefOp}{defOp} \usesdollar{setDefOp}{topOp} @@ -8262,6 +8431,13 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> +<> +<> +<> +<> +<> +<> <> <> <> diff --git a/changelog b/changelog index a8ab199..2533f9a 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20101019 tpd src/axiom-website/patches.html 20101019.01.tpd.patch +20101019 tpd src/interp/parsing.lisp treeshake compiler +20101019 tpd books/bookvol9 treeshake compiler 20101017 tpd src/axiom-website/patches.html 20101017.04.tpd.patch 20101017 tpd src/interp/parsing.lisp treeshake compiler 20101017 tpd books/bookvol9 treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index a1e6e9d..73b9cd2 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3234,5 +3234,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20101017.04.tpd.patch books/bookvol9 treeshake compiler
+20101019.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index cacf4de..eede122 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -1622,62 +1622,6 @@ preparse @ parse <<*>>= -;--% Transformation of Parser Output -; -;parseTransform x == -; $defOp: local:= nil -; x := substitute('$,'%,x) -- for new compiler compatibility -; parseTran x - -;;; *** |parseTransform| REDEFINED - -(DEFUN |parseTransform| (|x|) (PROG (|$defOp|) (DECLARE (SPECIAL |$defOp|)) (RETURN (PROGN (SPADLET |$defOp| NIL) (SPADLET |x| (MSUBST (QUOTE $) (QUOTE %) |x|)) (|parseTran| |x|))))) -;parseTran x == -; $op: local := nil -; atom x => parseAtom x -; [$op,:argl]:= x -; u := g($op) where g op == (op is ['elt,op,x] => g x; op) -; u='construct => -; r:= parseConstruct argl -; $op is ['elt,:.] => [parseTran $op,:rest r] -; r -; atom u and (fn:= GET(u,'parseTran)) => FUNCALL(fn,argl) -; [parseTran $op,:parseTranList argl] - -;;; *** |parseTran,g| REDEFINED - -(DEFUN |parseTran,g| (|op|) (PROG (|ISTMP#1| |ISTMP#2| |x|) (RETURN (SEQ (IF (AND (PAIRP |op|) (EQ (QCAR |op|) (QUOTE |elt|)) (PROGN (SPADLET |ISTMP#1| (QCDR |op|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |op| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |x| (QCAR |ISTMP#2|)) (QUOTE T))))))) (EXIT (|parseTran,g| |x|))) (EXIT |op|))))) - -;;; *** |parseTran| REDEFINED - -(DEFUN |parseTran| (|x|) (PROG (|$op| |argl| |u| |r| |fn|) (DECLARE (SPECIAL |$op|)) (RETURN (PROGN (SPADLET |$op| NIL) (COND ((ATOM |x|) (|parseAtom| |x|)) ((QUOTE T) (SPADLET |$op| (CAR |x|)) (SPADLET |argl| (CDR |x|)) (SPADLET |u| (|parseTran,g| |$op|)) (COND ((BOOT-EQUAL |u| (QUOTE |construct|)) (SPADLET |r| (|parseConstruct| |argl|)) (COND ((AND (PAIRP |$op|) (EQ (QCAR |$op|) (QUOTE |elt|))) (CONS (|parseTran| |$op|) (CDR |r|))) ((QUOTE T) |r|))) ((AND (ATOM |u|) (SPADLET |fn| (GETL |u| (QUOTE |parseTran|)))) (FUNCALL |fn| |argl|)) ((QUOTE T) (CONS (|parseTran| |$op|) (|parseTranList| |argl|)))))))))) -; -;parseAtom x == -; -- next line for compatibility with new compiler -; x = 'break => parseLeave ['$NoValue] -; x - -;;; *** |parseAtom| REDEFINED - -(DEFUN |parseAtom| (|x|) (COND ((BOOT-EQUAL |x| (QUOTE |break|)) (|parseLeave| (CONS (QUOTE |$NoValue|) NIL))) ((QUOTE T) |x|))) -; -;parseTranList l == -; atom l => parseTran l -; [parseTran first l,:parseTranList rest l] - -;;; *** |parseTranList| REDEFINED - -(DEFUN |parseTranList| (|l|) (COND ((ATOM |l|) (|parseTran| |l|)) ((QUOTE T) (CONS (|parseTran| (CAR |l|)) (|parseTranList| (CDR |l|)))))) -; -;parseConstruct u == -; $insideConstructIfTrue: local:= true -; l:= parseTranList u -; ["construct",:l] - -;;; *** |parseConstruct| REDEFINED - -(DEFUN |parseConstruct| (|u|) (PROG (|$insideConstructIfTrue| |l|) (DECLARE (SPECIAL |$insideConstructIfTrue|)) (RETURN (PROGN (SPADLET |$insideConstructIfTrue| (QUOTE T)) (SPADLET |l| (|parseTranList| |u|)) (CONS (QUOTE |construct|) |l|))))) -; ;parseUpArrow u == parseTran ["**",:u] ;;; *** |parseUpArrow| REDEFINED @@ -2165,20 +2109,7 @@ parse ;;; *** |parseExit| REDEFINED (DEFUN |parseExit| (#0=#:G167157) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CDR #0#)) (SPADLET |a| (|parseTran| |a|)) (SPADLET |b| (|parseTran| |b|)) (COND (|b| (COND ((NULL (integerp |a|)) (MOAN "first arg " |a| " for exit must be integer") (CONS (QUOTE |exit|) (CONS 1 (CONS |a| NIL)))) ((QUOTE T) (CONS (QUOTE |exit|) (CONS |a| |b|))))) ((QUOTE T) (CONS (QUOTE |exit|) (CONS 1 (CONS |a| NIL))))))))) -; -;parseLeave [a,:b] == -; a:= parseTran a -; b:= parseTran b -; b => -; null INTEGERP a => -; (MOAN('"first arg ",a,'" for 'leave' must be integer"); ['leave,1,a]) -; ['leave,a,:b] -; ['leave,1,a] - -;;; *** |parseLeave| REDEFINED -(DEFUN |parseLeave| (#0=#:G167176) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CDR #0#)) (SPADLET |a| (|parseTran| |a|)) (SPADLET |b| (|parseTran| |b|)) (COND (|b| (COND ((NULL (integerp |a|)) (MOAN "first arg " |a| " for 'leave' must be integer") (CONS (QUOTE |leave|) (CONS 1 (CONS |a| NIL)))) ((QUOTE T) (CONS (QUOTE |leave|) (CONS |a| |b|))))) ((QUOTE T) (CONS (QUOTE |leave|) (CONS 1 (CONS |a| NIL))))))))) -; ;parseReturn [a,:b] == ; a:= parseTran a ; b:= parseTran b @@ -2646,7 +2577,6 @@ parse ;;; *** |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 " " (APPEND (|bright| |u|) (CONS "is illegal because tuples cannot be applied!" (CONS (QUOTE |%l|) (CONS " 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