aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/compiler.boot41
-rw-r--r--src/interp/sys-macros.lisp11
2 files changed, 17 insertions, 35 deletions
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 9d79c3b3..99bbac79 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -2217,7 +2217,7 @@ compReduce(form,m,e) ==
compReduce1(form is ["REDUCE",op,.,collectForm],m,e,$formalArgList) ==
[collectOp,:itl,body]:= collectForm
if STRINGP op then op:= INTERN op
- ^MEMQ(collectOp,'(COLLECT COLLECTV COLLECTVEC)) =>
+ not MEMQ(collectOp,'(COLLECT COLLECTV)) =>
systemError ['"illegal reduction form:",form]
$sideEffectsList: local := nil
$until: local := nil
@@ -2269,6 +2269,7 @@ compRepeatOrCollect(form,m,e) ==
fn(form,$exitModeStack,$leaveLevelStack,$formalArgList,e) ==
$until: local := nil
oldEnv := e
+ aggr := nil
[repeatOrCollect,:itl,body]:= form
itl':=
[([x',e]:= compIterator(x,e) or return "failed"; x') for x in itl]
@@ -2276,15 +2277,14 @@ compRepeatOrCollect(form,m,e) ==
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
+ targetMode = $EmptyMode => (aggr:=["List",$EmptyMode]; $EmptyMode)
+ [aggr,u] := modeIsAggregateOf('List,targetMode,e) => u
+ [aggr,u] := modeIsAggregateOf('PrimitiveArray,targetMode,e) =>
+ repeatOrCollect := "COLLECTV"
+ u
+ [aggr,u] := modeIsAggregateOf('Vector,targetMode,e) =>
+ repeatOrCollect := "COLLECTV"
+ u
stackMessage('"Invalid collect bodytype")
return nil
-- If we're doing a collect, and the type isn't conformable
@@ -2296,16 +2296,8 @@ compRepeatOrCollect(form,m,e) ==
[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'' :=
+ aggr is [c,.] and MEMQ(c,'(List PrimitiveArray Vector)) => [c,m']
m'
T := coerceExit([form',m'',e'],targetMode) or return nil
-- iterator variables and other variables declared in
@@ -2410,16 +2402,15 @@ compIterator(it,e) ==
-- m
-- get(name,"value",e) is [c,R] and MEMQ(c,'(Vector List)) => R
-modeIsAggregateOf(ListOrVector,m,e) ==
- m is [ =ListOrVector,R] => [m,R]
---m = '$EmptyMode => [m,m] I don't think this is correct, breaks POLY +
+modeIsAggregateOf(agg,m,e) ==
+ m is [ =agg,R] => [m,R]
m is ["Union",:l] =>
- mList:= [pair for m' in l | (pair:= modeIsAggregateOf(ListOrVector,m',e))]
+ mList:= [pair for m' in l | (pair:= modeIsAggregateOf(agg,m',e))]
1=#mList => first mList
name:=
m is [fn,:.] => fn
RepIfRepHack m
- get(name,"value",e) is [[ =ListOrVector,R],:.] => [m,R]
+ get(name,"value",e) is [[ =agg,R],:.] => [m,R]
--% VECTOR ITERATORS
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index 1224c6a3..b610af09 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007-2008, Gabriel Dos Reis.
+;; Copyright (C) 2007-2009, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -1205,15 +1205,6 @@
(let ((U (REPEAT-TRAN L NIL)))
(CONS 'THETA (CONS '\, (NCONC (CAR U) (LIST (CDR U)))))))
-;; The following was changed to a macro for efficiency in CCL. To change
-;; it back to a function would require recompilation of a large chunk of
-;; the library.
-(defmacro PRIMVEC2ARR (x)
- x) ;redefine to change Array rep
-
-(defmacro COLLECTVEC (&rest L)
- `(PRIMVEC2ARR (COLLECTV ,@L)))
-
(defmacro COLLECTV (&rest L)
(PROG (CONDS BODY ANS COUNTER X Y)
;;If we can work out how often we will go round