From 44bee051936ea5f058e32be9c722b433686b8a4a Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Tue, 28 Apr 2009 05:12:25 +0000
Subject: 	* interp/compiler.boot (compComma): Supply element type for
 tuple 	construction. 	* interp/i-coerfn.boot (L2Tuple): Likewise. 	*
 interp/i-object.boot (asTupleNew): Likewise. 	(asTupleNew0): Likewise. 
 (asTupleNewCode): Likewise. 	(asTupleNewCode0): Likewise. 	*
 interp/i-spec1.boot (evalCOLLECT): Likewise. 	(interpCOLLECT): Likewise. 
 * interp/i-spec2.boot (evalTuple): Likewise. 	(upNullTuple): Likewise.

---
 src/interp/compiler.boot |  2 +-
 src/interp/i-coerfn.boot |  2 +-
 src/interp/i-object.boot | 16 +++++++++++-----
 src/interp/i-spec1.boot  |  6 +++---
 src/interp/i-spec2.boot  |  4 ++--
 5 files changed, 18 insertions(+), 12 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 82b8567d..c45a5ce8 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1793,7 +1793,7 @@ compComma(form,m,e) ==
   m is ["Tuple",t] =>
     Tl' := [convert(T,t) or return "failed" for T in Tl]
     Tl' = "failed" => nil
-    [["asTupleNew0", [T.expr for T in Tl']], m, e]
+    [["asTupleNew0", ["getVMType",t], [T.expr for T in Tl']], m, e]
   T := [["LIST2VEC", [T.expr for T in Tl]], 
         ["Cross",:[T.mode for T in Tl]], e]
   convert(T,m)
diff --git a/src/interp/i-coerfn.boot b/src/interp/i-coerfn.boot
index 5ee715f0..fa8eaeb6 100644
--- a/src/interp/i-coerfn.boot
+++ b/src/interp/i-coerfn.boot
@@ -563,7 +563,7 @@ L2Tuple(val, source is [.,S], target is [.,T]) ==
     val = '_$fromCoerceable_$ => canCoerce(S,T)
     null (object := coerceInt1(objNewWrap(val,source), ['List, T])) =>
       coercionFailure()
-    asTupleNew0 objValUnwrap object
+    asTupleNew0(getVMType T, objValUnwrap object)
 
 L2DP(l, source is [.,S], target is [.,n,T]) ==
   -- need to know size of the list
diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot
index 919d54a1..593b2d08 100644
--- a/src/interp/i-object.boot
+++ b/src/interp/i-object.boot
@@ -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
@@ -132,11 +132,17 @@ instantiationNormalForm(op,argl) ==
 
 -- Tuples and Crosses
 
-asTupleNew(size, listOfElts) == CONS(size, LIST2VEC listOfElts)
-asTupleNew0(listOfElts) == CONS(#listOfElts, LIST2VEC listOfElts)
+asTupleNew(eltType,size,listOfElts) == 
+  CONS(size, makeSimpleArrayFromList(eltType,listOfElts))
 
-asTupleNewCode(size, listOfElts) == ["asTupleNew", size, ["LIST", :listOfElts]]
-asTupleNewCode0(listForm) == ["asTupleNew0", listForm]
+asTupleNew0(eltType,listOfElts) == 
+  CONS(#listOfElts, makeSimpleArrayFromList(eltType,listOfElts))
+
+asTupleNewCode(eltType, size, listOfElts) == 
+  ["asTupleNew", quoteForm getVMType eltType, size, ["LIST", :listOfElts]]
+
+asTupleNewCode0(eltType,listForm) == 
+  ["asTupleNew0", quoteForm getVMType eltType, listForm]
 
 asTupleSize(at) == CAR at
 asTupleAsVector(at) == CDR at
diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot
index 8cc56925..7f9600c0 100644
--- a/src/interp/i-spec1.boot
+++ b/src/interp/i-spec1.boot
@@ -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
@@ -542,7 +542,7 @@ evalCOLLECT(op,[:itrl,body],m) ==
   iters := [evalLoopIter itr for itr in itrl]
   bod := getArgValue(body,computedMode body)
   if bod isnt ['SPADCALL,:.] then bode := ['unwrap,bod]
-  code := timedOptimization asTupleNewCode0 ['COLLECT,:iters,bod]
+  code := timedOptimization asTupleNewCode0(second m, ['COLLECT,:iters,bod])
   if $genValue then code := wrap timedEVALFUN code
   putValue(op,objNew(code,m))
 
@@ -580,7 +580,7 @@ interpCOLLECT(op,itrl,body) ==
   rm := ['Tuple,t]
   value := [objValUnwrap coerceInteractive(objNewWrap(v,m),t)
     for v in value for m in $collectTypeList]
-  putValue(op,objNewWrap(asTupleNew(#value, value),rm))
+  putValue(op,objNewWrap(asTupleNew(getVMType t, #value, value),rm))
   putModeSet(op,[rm])
 
 interpIter itr ==
diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot
index 7c849c00..175cab07 100644
--- a/src/interp/i-spec2.boot
+++ b/src/interp/i-spec2.boot
@@ -1091,7 +1091,7 @@ uptuple t ==
 
 evalTuple(op,l,m,tar) ==
   [agg,:.,underMode]:= m
-  code := asTupleNewCode(#l,
+  code := asTupleNewCode(underMode, #l,
     [(getArgValue(x,underMode) or throwKeyedMsg("S2IC0007",[underMode])) for x in l])
   val :=
     $genValue => objNewWrap(timedEVALFUN code,m)
@@ -1110,7 +1110,7 @@ upNullTuple(op,l,tar) ==
     tar and tar is [a,b] and (a in '(Stream Vector List)) and
       not isPartialMode(b) => ['Tuple,b]
     '(Tuple (None))
-  val := objNewWrap(asTupleNew(0,NIL), defMode)
+  val := objNewWrap(asTupleNew(getVMType second defMode,0,NIL), defMode)
   tar and not isPartialMode(tar) =>
     null (val' := coerceInteractive(val,tar)) =>
       throwKeyedMsg("S2IS0013",[tar])
-- 
cgit v1.2.3