diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 0cacffb..401343d 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -3693,7 +3693,7 @@ An angry JHD - August 15th., 1984 (pairp (qcdr y)) (eq (qcdr (qcdr y)) nil)) (list y (second y))) (t (list y)))) ) - (let (argl catList pl tmp2 tmp3 tmp4 tmp5 body parameters catListp td) + (let (argl catList pl tmp3 tmp4 tmp5 body parameters catListp td) (declare (special |$Category|)) (setq argl (cdr arg)) (setq catList @@ -3917,6 +3917,112 @@ An angry JHD - August 15th., 1984 @ +\defplist{collect}{compRepeatOrCollect} +<>= +(eval-when (eval load) + (setf (get 'collect 'special) '|compRepeatOrCollect|)) + +@ + +\defplist{repeat}{compRepeatOrCollect} +<>= +(eval-when (eval load) + (setf (get 'repeat 'special) '|compRepeatOrCollect|)) + +@ + +\defun{compRepeatOrCollect}{compRepeatOrCollect} +\calls{compRepeatOrCollect}{length} +\calls{compRepeatOrCollect}{compIterator} +\calls{compRepeatOrCollect}{modeIsAggregateOf} +\calls{compRepeatOrCollect}{stackMessage} +\calls{compRepeatOrCollect}{compOrCroak} +\calls{compRepeatOrCollect}{comp} +\calls{compRepeatOrCollect}{msubst} +\calls{compRepeatOrCollect}{coerceExit} +\calls{compRepeatOrCollect}{} +\calls{compRepeatOrCollect}{} +\usesdollar{compRepeatOrCollect}{until} +\usesdollar{compRepeatOrCollect}{Boolean} +\usesdollar{compRepeatOrCollect}{NoValueMode} +\usesdollar{compRepeatOrCollect}{exitModeStack} +\usesdollar{compRepeatOrCollect}{leaveLevelStack} +\usesdollar{compRepeatOrCollect}{formalArgList} +<>= +(defun |compRepeatOrCollect| (form m e) + (labels ( + (fn (form |$exitModeStack| |$leaveLevelStack| |$formalArgList| e) + (declare (special |$exitModeStack| |$leaveLevelStack| |$formalArgList|)) + (let (|$until| body itl xp targetMode repeatOrCollect bodyMode bodyp mp tmp1 + untilCode ep itlp formp u mpp tmp2) + (declare (special |$Boolean| |$until| |$NoValueMode| )) + (setq |$until| nil) + (setq repeatOrCollect (car form)) + (setq tmp1 (reverse (cdr form))) + (setq body (car tmp1)) + (setq itl (nreverse (cdr tmp1))) + (setq itlp + (dolist (x itl (nreverse0 tmp2)) + (setq tmp1 (or (|compIterator| x e) (return '|failed|))) + (setq xp (first tmp1)) + (setq e (second tmp1)) + (push xp tmp2))) + (unless (eq itlp '|failed|) + (setq targetMode (car |$exitModeStack|)) + (setq bodyMode + (if (eq repeatOrCollect 'collect) + (cond + ((eq targetMode '|$EmptyMode|) + '|$EmptyMode|) + ((setq u (|modeIsAggregateOf| '|List| targetMode e)) + (second u)) + ((setq u (|modeIsAggregateOf| '|PrimitiveArray| targetMode e)) + (setq repeatOrCollect 'collectv) + (second u)) + ((setq u (|modeIsAggregateOf| '|Vector| targetMode e)) + (setq repeatOrCollect 'collectvec) + (second u)) + (t + (|stackMessage| "Invalid collect bodytype") + '|failed|)) + |$NoValueMode|)) + (unless (eq bodyMode '|failed|) + (when (setq tmp1 (|compOrCroak| body bodyMode e)) + (setq bodyp (first tmp1)) + (setq mp (second tmp1)) + (setq ep (third tmp1)) + (when |$until| + (setq tmp1 (|comp| |$until| |$Boolean| ep)) + (setq untilCode (first tmp1)) + (setq ep (third tmp1)) + (setq itlp (msubst (list 'until untilCode) '|$until| itlp))) + (setq formp (cons repeatOrCollect (append itlp (list bodyp)))) + (setq mpp + (cond + ((eq repeatOrCollect 'collect) + (if (setq u (|modeIsAggregateOf| '|List| targetMode e)) + (car u) + (list '|List| mp))) + ((eq repeatOrCollect 'collectv) + (if (setq u (|modeIsAggregateOf| '|PrimitiveArray| targetMode e)) + (car u) + (list '|PrimitiveArray| mp))) + ((eq repeatOrCollect 'collectvec) + (if (setq u (|modeIsAggregateOf| '|Vector| targetMode e)) + (car u) + (list '|Vector| mp))) + (t mp))) + (|coerceExit| (list formp mpp ep) targetMode)))))) ) + (declare (special |$exitModeStack| |$leaveLevelStack| |$formalArgList|)) + (fn form + (cons m |$exitModeStack|) + (cons (|#| |$exitModeStack|) |$leaveLevelStack|) + |$formalArgList| + e))) + + +@ + \defplist{reduce}{compReduce} <>= (eval-when (eval load) @@ -11321,6 +11427,7 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> <> <> <> diff --git a/changelog b/changelog index 6b097c3..e9d5ba1 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20101205 tpd src/axiom-website/patches.html 20101205.02.tpd.patch +20101205 tpd src/interp/postprop.lisp treeshake compiler +20101205 tpd src/interp/iterator.lisp treeshake compiler +20101205 tpd books/bookvol9 treeshake compiler 20101205 tpd src/axiom-website/patches.html 20101205.01.tpd.patch 20101205 tpd src/axiom-website/download.html add ubuntu 20101130 tpd src/axiom-website/patches.html 20101130.01.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index d3cd92c..eb218c2 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3293,5 +3293,7 @@ In process, not yet released

20101205.01.tpd.patch src/axiom-website/download.html add ubuntu
+20101205.02.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/iterator.lisp.pamphlet b/src/interp/iterator.lisp.pamphlet index ae3d6b7..7015ad7 100644 --- a/src/interp/iterator.lisp.pamphlet +++ b/src/interp/iterator.lisp.pamphlet @@ -40,193 +40,6 @@ ((ATOM |x|) |x|) ('T (CONS (|numberize| (CAR |x|)) (|numberize| (CDR |x|)))))) -;compRepeatOrCollect(form,m,e) == -; fn(form,[m,:$exitModeStack],[#$exitModeStack,:$leaveLevelStack],$formalArgList -; ,e) where -; fn(form,$exitModeStack,$leaveLevelStack,$formalArgList,e) == -; $until: local := nil -; [repeatOrCollect,:itl,body]:= form -; itl':= -; [([x',e]:= compIterator(x,e) or return "failed"; x') for x in itl] -; itl'="failed" => nil -; targetMode:= first $exitModeStack -; bodyMode:= -; repeatOrCollect="COLLECT" => -; targetMode = '$EmptyMode => '$EmptyMode -; (u:=modeIsAggregateOf('List,targetMode,e)) => -; CADR u -; (u:=modeIsAggregateOf('PrimitiveArray,targetMode,e)) => -; repeatOrCollect:='COLLECTV -; CADR u -; (u:=modeIsAggregateOf('Vector,targetMode,e)) => -; repeatOrCollect:='COLLECTVEC -; CADR u -; stackMessage('"Invalid collect bodytype") -; return nil -; -- If we're doing a collect, and the type isn't conformable -; -- then we've boobed. JHD 26.July.1990 -; $NoValueMode -; [body',m',e']:= -; -- (m1:= listOrVectorElementMode targetMode) and comp(body,m1,e) or -; compOrCroak(body,bodyMode,e) or return nil -; if $until then -; [untilCode,.,e']:= comp($until,$Boolean,e') -; itl':= substitute(["UNTIL",untilCode],'$until,itl') -; form':= [repeatOrCollect,:itl',body'] -; m'':= -; repeatOrCollect="COLLECT" => -; (u:=modeIsAggregateOf('List,targetMode,e)) => CAR u -; ["List",m'] -; repeatOrCollect="COLLECTV" => -; (u:=modeIsAggregateOf('PrimitiveArray,targetMode,e)) => CAR u -; ["PrimitiveArray",m'] -; repeatOrCollect="COLLECTVEC" => -; (u:=modeIsAggregateOf('Vector,targetMode,e)) => CAR u -; ["Vector",m'] -; m' -; coerceExit([form',m'',e'],targetMode) - -(DEFUN |compRepeatOrCollect,fn| - (|form| |$exitModeStack| |$leaveLevelStack| |$formalArgList| |e|) - (DECLARE (SPECIAL |$exitModeStack| |$leaveLevelStack| |$formalArgList| )) - (PROG (|$until| |body| |itl| |x'| |targetMode| |repeatOrCollect| - |bodyMode| |body'| |m'| |LETTMP#1| |untilCode| |e'| |itl'| - |form'| |u| |m''|) - (DECLARE (SPECIAL |$Boolean| |$until| |$NoValueMode| )) - (RETURN - (SEQ (SPADLET |$until| NIL) - (PROGN - (SPADLET |repeatOrCollect| (CAR |form|)) - (SPADLET |LETTMP#1| (REVERSE (CDR |form|))) - (SPADLET |body| (CAR |LETTMP#1|)) - (SPADLET |itl| (NREVERSE (CDR |LETTMP#1|))) - |form|) - (SPADLET |itl'| - (PROG (G166269) - (SPADLET G166269 NIL) - (RETURN - (DO ((G166278 |itl| (CDR G166278)) - (|x| NIL)) - ((OR (ATOM G166278) - (PROGN - (SETQ |x| (CAR G166278)) - NIL)) - (NREVERSE0 G166269)) - (SEQ (EXIT (SETQ G166269 - (CONS - (SEQ - (PROGN - (SPADLET |LETTMP#1| - (OR (|compIterator| |x| |e|) - (RETURN '|failed|))) - (SPADLET |x'| - (CAR |LETTMP#1|)) - (SPADLET |e| - (CADR |LETTMP#1|)) - |LETTMP#1|) - (EXIT |x'|)) - G166269)))))))) - (IF (BOOT-EQUAL |itl'| '|failed|) (EXIT NIL)) - (SPADLET |targetMode| (CAR |$exitModeStack|)) - (SPADLET |bodyMode| - (SEQ (IF (BOOT-EQUAL |repeatOrCollect| 'COLLECT) - (EXIT (SEQ - (IF - (BOOT-EQUAL |targetMode| - '|$EmptyMode|) - (EXIT '|$EmptyMode|)) - (IF - (SPADLET |u| - (|modeIsAggregateOf| '|List| - |targetMode| |e|)) - (EXIT (CADR |u|))) - (IF - (SPADLET |u| - (|modeIsAggregateOf| - '|PrimitiveArray| |targetMode| - |e|)) - (EXIT - (SEQ - (SPADLET |repeatOrCollect| - 'COLLECTV) - (EXIT (CADR |u|))))) - (IF - (SPADLET |u| - (|modeIsAggregateOf| '|Vector| - |targetMode| |e|)) - (EXIT - (SEQ - (SPADLET |repeatOrCollect| - 'COLLECTVEC) - (EXIT (CADR |u|))))) - (|stackMessage| "Invalid collect bodytype") - (EXIT (RETURN NIL))))) - (EXIT |$NoValueMode|))) - (PROGN - (SPADLET |LETTMP#1| - (OR (|compOrCroak| |body| |bodyMode| |e|) - (RETURN NIL))) - (SPADLET |body'| (CAR |LETTMP#1|)) - (SPADLET |m'| (CADR |LETTMP#1|)) - (SPADLET |e'| (CADDR |LETTMP#1|)) - |LETTMP#1|) - (IF |$until| - (SEQ (PROGN - (SPADLET |LETTMP#1| - (|comp| |$until| |$Boolean| |e'|)) - (SPADLET |untilCode| (CAR |LETTMP#1|)) - (SPADLET |e'| (CADDR |LETTMP#1|)) - |LETTMP#1|) - (EXIT (SPADLET |itl'| - (MSUBST - (CONS 'UNTIL - (CONS |untilCode| NIL)) - '|$until| |itl'|)))) - NIL) - (SPADLET |form'| - (CONS |repeatOrCollect| - (APPEND |itl'| (CONS |body'| NIL)))) - (SPADLET |m''| - (SEQ (IF (BOOT-EQUAL |repeatOrCollect| 'COLLECT) - (EXIT (SEQ - (IF - (SPADLET |u| - (|modeIsAggregateOf| '|List| - |targetMode| |e|)) - (EXIT (CAR |u|))) - (EXIT - (CONS '|List| (CONS |m'| NIL)))))) - (IF (BOOT-EQUAL |repeatOrCollect| 'COLLECTV) - (EXIT (SEQ - (IF - (SPADLET |u| - (|modeIsAggregateOf| - '|PrimitiveArray| |targetMode| - |e|)) - (EXIT (CAR |u|))) - (EXIT - (CONS '|PrimitiveArray| - (CONS |m'| NIL)))))) - (IF (BOOT-EQUAL |repeatOrCollect| 'COLLECTVEC) - (EXIT (SEQ - (IF - (SPADLET |u| - (|modeIsAggregateOf| '|Vector| - |targetMode| |e|)) - (EXIT (CAR |u|))) - (EXIT - (CONS '|Vector| (CONS |m'| NIL)))))) - (EXIT |m'|))) - (EXIT (|coerceExit| - (CONS |form'| (CONS |m''| (CONS |e'| NIL))) - |targetMode|)))))) - -(DEFUN |compRepeatOrCollect| (|form| |m| |e|) - (declare (special |$exitModeStack| |$leaveLevelStack| |$formalArgList|)) - (|compRepeatOrCollect,fn| |form| (CONS |m| |$exitModeStack|) - (CONS (|#| |$exitModeStack|) |$leaveLevelStack|) |$formalArgList| - |e|)) - ;--constructByModemap([x,source,e],target) == ;-- u:= ;-- [cexpr diff --git a/src/interp/postprop.lisp.pamphlet b/src/interp/postprop.lisp.pamphlet index 105bdcc..44ab3a0 100644 --- a/src/interp/postprop.lisp.pamphlet +++ b/src/interp/postprop.lisp.pamphlet @@ -81,8 +81,8 @@ ; (|pretend| |compPretend|) ; (QUOTE |compQuote|) ; (REDUCE |compReduce|) - (COLLECT |compRepeatOrCollect|) - (REPEAT |compRepeatOrCollect|) +; (COLLECT |compRepeatOrCollect|) +; (REPEAT |compRepeatOrCollect|) (|return| |compReturn|) (LET |compSetq|) (SETQ |compSetq|)