* interp/c-util.boot ($middleEndMacroList): Remove COLLECTV.

	* interp/compiler.boot: Don't register compiler for COLLECTV forms.
	(compReduce1): Don't test for COLLECTV.
	(localReferenceIfThere): New.
	(compRepeatOrCollect): Use it.  Tidy.
	(compCollectV): Remove.
	(compIteratorV): Likewise.
	(computeMaxIndex): Likewise.
	(exprDifference): Likewise.
	* interp/g-opt.boot (optCollectVector): New.  Register as
	back end tranformer.
	* interp/sys-macros.lisp (COLLECTV): Remove.

4 files changed, 57 insertions, 135 deletions

diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index c7cdd14f..945ac812 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -988,8 +988,7 @@ mutateLETFormWithUnaryFunction(form,fun) ==
 -- NOTE: It is potentially dangerous to assume every occurrence of 
 -- element of $middleEndMacroList is actually a macro call
 $middleEndMacroList == 
-  '(COLLECT REPEAT SUCHTHATCLAUSE THETA COLLECTV 
-    THETA1 SPADREDUCE SPADDO)
+  '(COLLECT REPEAT SUCHTHATCLAUSE THETA THETA1 SPADREDUCE SPADDO)
 
 middleEndExpand: %Form -> %Form
 middleEndExpand x ==
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 99bbac79..f5b1e292 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -2217,8 +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
-  not MEMQ(collectOp,'(COLLECT COLLECTV)) =>
-        systemError ['"illegal reduction form:",form]
+  collectOp ^= "COLLECT" => systemError ['"illegal reduction form:",form]
   $sideEffectsList: local := nil
   $until: local := nil
   $initList: local := nil
@@ -2262,7 +2261,14 @@ numberize x ==
   x=$One => 1
   atom x => x
   [numberize first x,:numberize rest x]
- 
+
+++ If there is a local reference to mode `m', return it.  Otherwise
+++ return `m' itself.
+localReferenceIfThere m ==
+  m = "$" => m
+  idx := NRTassocIndex m => ["getShellEntry","$",idx]
+  m
+
 compRepeatOrCollect(form,m,e) ==
   fn(form,[m,:$exitModeStack],[#$exitModeStack,:$leaveLevelStack],$formalArgList
     ,e) where
@@ -2280,10 +2286,10 @@ compRepeatOrCollect(form,m,e) ==
             targetMode = $EmptyMode => (aggr:=["List",$EmptyMode]; $EmptyMode)
             [aggr,u] := modeIsAggregateOf('List,targetMode,e) => u
             [aggr,u] := modeIsAggregateOf('PrimitiveArray,targetMode,e) =>
-              repeatOrCollect := "COLLECTV"
+              repeatOrCollect := "%CollectV"
               u
             [aggr,u] := modeIsAggregateOf('Vector,targetMode,e) =>
-              repeatOrCollect := "COLLECTV"
+              repeatOrCollect := "%CollectV"
               u
             stackMessage('"Invalid collect bodytype")
             return nil
@@ -2295,7 +2301,10 @@ compRepeatOrCollect(form,m,e) ==
         if $until then
           [untilCode,.,e']:= comp($until,$Boolean,e')
           itl':= substitute(["UNTIL",untilCode],'$until,itl')
-        form':= [repeatOrCollect,:itl',body']
+        form':= 
+           repeatOrCollect = "%CollectV" => 
+             ["%CollectV",localReferenceIfThere m',:itl',body']
+           [repeatOrCollect,:itl',body']
         m'' := 
           aggr is [c,.] and MEMQ(c,'(List PrimitiveArray Vector)) => [c,m']
           m'
@@ -2412,67 +2421,6 @@ modeIsAggregateOf(agg,m,e) ==
     RepIfRepHack m
   get(name,"value",e) is [[ =agg,R],:.] => [m,R]
  
---% VECTOR ITERATORS
- 
---the following 4 functions are not currently used
- 
-compCollectV(form,m,e) ==
-  fn(form,[m,:$exitModeStack],[#$exitModeStack,:$leaveLevelStack],e) where
-    fn(form,$exitModeStack,$leaveLevelStack,e) ==
-      [repeatOrCollect,it,body]:= form
-      [it',e]:= compIteratorV(it,e) or return nil
-      m:= first $exitModeStack
-      [mOver,mUnder]:= modeIsAggregateOf("Vector",m,e) or $EmptyMode
-      [body',m',e']:= compOrCroak(body,mUnder,e) or return nil
-      form':= ["COLLECTV",it',body']
-      n:=
-	it' is ["STEP",.,s,i,f] or it' is ["ISTEP",.,s,i,f] =>
-	      computeMaxIndex(s,f,i);
-	return nil
-      coerce([form',mOver,e'],m)
-
-compIteratorV(it,e) ==
-  it is ["STEP",index,start,inc,final] =>
-    (start':= comp(start,$Integer,e)) and
-      (inc':= comp(inc,$NonNegativeInteger,start'.env)) and
-       (final':= comp(final,$Integer,inc'.env)) =>
-	indexmode:=
-	  comp(start,$NonNegativeInteger,e) => $NonNegativeInteger
-	  $Integer
-	if null get(index,"mode",e) then [.,.,e]:=
-	  compMakeDeclaration(index,indexmode,final'.env) or
-	    return nil
-	e:= put(index,"value",[genSomeVariable(),indexmode,$noEnv],e)
-	[["ISTEP",index,start'.expr,inc'.expr,final'.expr],e]
-    [start,.,e]:=
-      comp(start,$Integer,e) or return
-	stackMessage('"start value of index: %1b is not an integer",[start])
-    [inc,.,e]:=
-      comp(inc,$NonNegativeInteger,e) or return
-	stackMessage('"index increment: %1b must be a non-negative integer",
-          [inc])
-    [final,.,e]:=
-      comp(final,$Integer,e) or return
-	stackMessage('"final value of index: %1b is not an integer",[final])
-    indexmode:=
-      comp(CADDR it,$NonNegativeInteger,e) => $NonNegativeInteger
-      $Integer
-    if null get(index,"mode",e) then [.,.,e]:=
-      compMakeDeclaration(index,indexmode,e) or return nil
-    e:= put(index,"value",[genSomeVariable(),indexmode,$noEnv],e)
-    [["STEP",index,start,inc,final],e]
-  nil
-
-computeMaxIndex(s,f,i) ==
-  i^=1 => cannotDo()
-  s=1 => f
-  exprDifference(f,exprDifference(s,1))
-
-exprDifference(x,y) ==
-  y=0 => x
-  FIXP x and FIXP y => DIFFERENCE(x,y)
-  ["DIFFERENCE",x,y]
-
 
 --% rep/per morphisms
 
@@ -2551,7 +2499,6 @@ for x in [["|", :"compSuchthat"],_
 	  ["case", :"compCase"],_
 	  ["CATEGORY", :"compCategory"],_
 	  ["COLLECT", :"compRepeatOrCollect"],_
-	  ["COLLECTV", :"compCollectV"],_
 	  ["CONS", :"compCons"],_
 	  ["construct", :"compConstruct"],_
 	  ["DEF", :"compDefine"],_
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 0fb44255..1104d4ec 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -501,6 +501,46 @@ optLET_* form ==
   rplac(first form,"LET")
   optLET form
 
+optCollectVector form ==
+  [.,eltType,:iters,body] := form
+  fromList := false      -- are we drawing from a list?
+  vecSize := nil         -- size of vector
+  index := nil           -- loop/vector index.
+  for iter in iters while not fromList repeat
+    [op,:.] := iter
+    MEMQ(op,'(SUCHTHAT WHILE UNTIL)) => fromList := true
+    MEMQ(op,'(IN ON)) => vecSize := [["SIZE",third iter],:vecSize]
+    MEMQ(op,'(STEP ISTEP)) =>
+     -- pick a loop variable that we can use as the loop index.
+     [.,var,lo,inc,:etc] := iter
+     if lo = 0 and inc = 1 then
+       index := var
+     if [hi] := etc then
+       sz :=
+         inc = 1 =>
+           lo = 1 => hi
+           lo = 0 => MKQSADD1 hi
+           MKQSADD1 ["-",hi,lo]
+         lo = 1 => ["/",hi,inc]
+         lo = 0 => ["/",MKQSADD1 hi,inc]
+         ["/",["-",MKQSADD1 hi, lo],inc]
+       vecSize := [sz, :vecSize]
+  -- if we draw from a list, then just build a list and convert to vector.
+  fromList => ["LIST2VEC",["COLLECT",:iters,body]]
+  vecSize = nil => systemErrorHere ["optCollectVector",form]
+  -- get the actual size of the vector.
+  vecSize :=
+    vecSize is [hi] => hi
+    ["MIN",:nreverse vecSize]
+  -- if no suitable loop index was found, introduce one.
+  if index = nil then
+    index := GENSYM()
+    iters := [:iters,["ISTEP",index,0,1]]
+  vec := GENSYM()
+  ["LET",[[vec,["GETREFV",vecSize]]],
+    ["REPEAT",:iters,["setSimpleArrayEntry",vec,index,body]], 
+      vec]
+ 
 lispize x == first optimize [x]
  
 --% optimizer hash table
@@ -517,6 +557,7 @@ for x in '( (call         optCall) _
            (_|           optSuchthat)_
            (CATCH        optCatch)_
            (COND         optCond)_
+           (%CollectV    optCollectVector)_
            (mkRecord     optMkRecord)_
            (RECORDELT    optRECORDELT)_
            (SETRECORDELT optSETRECORDELT)_
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index b610af09..d0f934ad 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -1205,71 +1205,6 @@
   (let ((U (REPEAT-TRAN L NIL)))
     (CONS 'THETA (CONS '\, (NCONC (CAR U) (LIST (CDR U)))))))
 
-(defmacro COLLECTV (&rest L)
-  (PROG (CONDS BODY ANS COUNTER X Y)
-	;;If we can work out how often we will go round
-	;; allocate a vector first
-	(SETQ CONDS NIL)
-	(SETQ BODY (REVERSE L))
-	(SETQ ANS (GENSYM))
-	(SETQ COUNTER NIL)
-	(SETQ X (CDR BODY))
-	(SETQ BODY (CAR BODY))
-	LP  
-	(COND ((NULL X)
-	       (COND ((NULL COUNTER)
-		      (SETQ COUNTER (GENSYM))
-		      (SETQ L (CONS (LIST 'ISTEP COUNTER 0 1) L)) ))
-	       (RETURN (LIST 'PROGN
-			     (LIST 'SPADLET 
-				   ANS
-				   (LIST 'GETREFV
-					 (COND ((NULL CONDS)
-						(fail))
-					       ((NULL (CDR CONDS))
-						(CAR CONDS))
-					       ((CONS 'MIN CONDS)) ) ))
-			     (CONS 'REPEAT 
-				   (NCONC (CDR (REVERSE L))
-					  (LIST (LIST '|setSimpleArrayEntry|
-						      ANS 
-						      COUNTER
-						      BODY))))
-			     ANS)) ))
-	(SETQ Y (CAR X))
-	(SETQ X (CDR X))
-	(COND ((MEMQ (CAR Y) '(SUCHTHAT WHILE UNTIL))
-	       (RETURN (LIST 'LIST2VEC (CONS 'COLLECT L)) ))
-	      ((member (CAR Y) '(IN ON) :test #'eq)
-	       (SETQ CONDS (CONS (LIST 'SIZE (CADDR Y)) CONDS))
-	       (GO LP))
-	      ((member (CAR Y) '(STEP ISTEP) :test #'eq)
-	       (if (AND (EQL (CADDR Y) 0) 
-			(EQL (CADDDR Y) 1))
-		   (SETQ COUNTER (CADR Y)) )
-	       (COND ((CDDDDR Y)    ; there may not be a limit
-		      (SETQ CONDS 
-			    (CONS
-			     (COND ((EQL 1 (CADDDR Y))
-				    (COND ((EQL 1 (CADDR Y))
-					   (CAR (CDDDDR Y)))
-					  ((EQL 0 (CADDR Y))
-					   (MKQSADD1 (CAR (CDDDDR Y))))
-					  ((MKQSADD1 `(- ,(CAR (CDDDDR Y))
-							 ,(CADDR Y))))))
-				   ((EQL 1 (CADDR Y)) 
-				    `(/ ,(CAR (CDDDDR Y)) ,(CADDR Y)))
-				   ((EQL 0 (CADDR Y))
-				    `(/ ,(MKQSADD1 (CAR (CDDDDR Y)))
-					,(CADDR Y)))
-				   (`(/ (- ,(MKQSADD1 (CAR (CDDDDR Y)))
-					   ,(CADDR Y))
-					,(CADDR Y))))
-			     CONDS))))
-	       (GO LP)))
-	(ERROR "Cannot handle macro expansion")))
-
-
 ;; 
 ;; -*- Non-Local Gotos -*-
 ;;