[move arrays to jhc-prim, remove special IORef specific primitives in favor of length 1 arrays
John Meacham <john@repetae.net>**20120206081357
 Ignore-this: 2f09c2c15989dcbed6cd622a0847e14
] hunk ./Makefile.am 327
-    lib/jhc/Jhc/Type/C.hs lib/jhc/Jhc/Inst/PrimEnum.hs lib/jhc/Jhc/Inst/Show.hs lib/jhc/Jhc/Array.hs lib/jhc/Prelude/Text.hs \
+    lib/jhc/Jhc/Type/C.hs lib/jhc/Jhc/Inst/PrimEnum.hs lib/jhc/Jhc/Inst/Show.hs lib/jhc/Prelude/Text.hs \
hunk ./lib/base/Data/Array.hs 2
-module  Data.Array (
+module Data.Array (
hunk ./lib/base/Data/Array.hs 7
+    accumArray,
hunk ./lib/base/Data/Array.hs 13
-    accumArray,
hunk ./lib/base/Data/Array.hs 19
-import Jhc.Array
+import Jhc.Basics
hunk ./lib/base/Data/Array.hs 21
+import Jhc.Prim.Array
+import Jhc.Prim.IO
hunk ./lib/base/Data/Array.hs 26
-
-data Array a b = MkArray !a !a (Array__ b)
+data Array a b = MkArray !a !a (Array_ b)
hunk ./lib/base/Data/Array.hs 92
+foreign import primitive newWorld__ :: a -> World__
+
+newArray :: a -> Int -> [(Int,a)] -> Array_ a
+newArray init n xs = case unboxInt n of
+    n' -> case newWorld__ (init,n,xs) of
+     w -> case newArray__ n' init w of
+      (# w, arr #) -> let
+        f :: MutArray_ a -> World__ -> [(Int,a)] -> World__
+        f arr w [] = w
+        f arr w ((i,v):xs) = case unboxInt i of i' -> case writeArray__ arr i' v w of w -> f arr w xs
+            in case f arr w xs of w -> Array_ arr `worldDep_` w
+
+foreign import primitive "dependingOn" worldDep_ :: Array_ b -> World__ -> Array_ b
hunk ./lib/base/Data/Array/IO.hs 4
+import Jhc.Prim.Array
hunk ./lib/base/Data/Array/IO.hs 7
-import Jhc.Array
hunk ./lib/base/Data/Array/IO.hs 11
-data IOArray a b = IOA !a !a (MutArray__ b)
+data IOArray a b = IOA !a !a (MutArray_ b)
hunk ./lib/base/Data/Array/IO.hs 19
-      size__ -> case newMutArray__ size__ fill w1 of
+      size__ -> case newArray__ size__ fill w1 of
hunk ./lib/base/Data/IORef.hs 1
-{-# OPTIONS_JHC -fno-prelude -funboxed-tuples -fffi #-}
+{-# OPTIONS_JHC -funboxed-values -fno-prelude -funboxed-tuples -fffi #-}
hunk ./lib/base/Data/IORef.hs 11
+import Jhc.Prim.Array
hunk ./lib/base/Data/IORef.hs 17
-data IORef a = IORef (Ref__ a)
-data Ref__ a :: #
+data IORef a = IORef (MutArray_ a)
hunk ./lib/base/Data/IORef.hs 19
-foreign import primitive newRef__   :: a -> UIO (Ref__ a)
-foreign import primitive readRef__  :: Ref__ a -> UIO a
-foreign import primitive writeRef__ :: Ref__ a -> a -> UIO_
+newRef__ a = newArray__ 1# a
+writeRef__ m v = writeArray__ m 0# v
+readRef__ m = readArray__ m 0#
hunk ./lib/base/Data/IORef.hs 52
-{-
---newIORef v = IO $ \_ world -> case newRef__ v world of
---    (world',r) -> JustIO world' r
---readIORef r = IO $ \_ world -> case readRef__ r world of
---    (world',v) -> JustIO world' v
---writeIORef r v = IO $ \_ world -> case writeRef__ r v world of
---    world' -> JustIO world' ()
-{-# NOINLINE newIORef #-}
-newIORef :: a -> IO (IORef a)
-newIORef v = do
-    v' <- strictReturn v
-    return (IORef v')
-
-{-# NOINLINE readIORef #-}
-readIORef :: IORef a -> IO a
-readIORef r = do
-    --v <- strictReturn r
-    case r of
-        IORef r -> strictReturn r
--}
-
---foreign import primitive newRef__ :: forall s . a -> s -> (s,Ref s a)
---foreign import primitive readRef__ :: forall s . Ref s a -> s -> (s,a)
hunk ./lib/jhc-prim/jhc-prim.yaml 8
-#        - Jhc.Prim.Words
+        - Jhc.Prim.Array
hunk ./lib/jhc/Foreign/Marshal/Alloc.hs 91
---
hunk ./lib/jhc/Jhc/Array.hs 1
-{-# OPTIONS_JHC -fno-prelude -funboxed-tuples -fffi #-}
-module Jhc.Array where
-
-import Jhc.Basics
-import Jhc.IO
-import Jhc.Int
-
-data MutArray__ :: * -> #
-data Array__ :: * -> #
-
-foreign import primitive newMutArray__      :: Int_ -> a -> UIO (MutArray__ a)
-foreign import primitive newBlankMutArray__ :: Int_ -> UIO (MutArray__ a)
-foreign import primitive copyArray__        :: Int_ -> Int_ -> Int_ -> Array__ a -> MutArray__ a -> UIO_
-foreign import primitive copyMutArray__     :: Int_ -> Int_ -> Int_ -> MutArray__ a -> MutArray__ a -> UIO_
-foreign import primitive readArray__        :: MutArray__ a -> Int_ -> UIO a
-foreign import primitive writeArray__       :: MutArray__ a -> Int_ -> a -> UIO_
-foreign import primitive indexArray__       :: Array__ a -> Int_ -> (# a #)
-
--- these basically cast from a mutable to an immutable array and back again
-foreign import primitive unsafeFreezeArray__ :: MutArray__ a -> UIO (Array__ a)
-foreign import primitive unsafeThawArray__ :: Array__ a -> UIO (MutArray__ a)
-
-foreign import primitive newWorld__ :: a -> World__
-
-newArray :: a -> Int -> [(Int,a)] -> Array__ a
-newArray init n xs = case unboxInt n of
-    n' -> case newWorld__ (init,n,xs) of
-     w -> case newMutArray__ n' init w of
-      (# w, arr #) -> let
-        f :: MutArray__ a -> World__ -> [(Int,a)] -> World__
-        f arr w [] = w
-        f arr w ((i,v):xs) = case unboxInt i of i' -> case writeArray__ arr i' v w of w -> f arr w xs
-            in case f arr w xs of w -> case unsafeFreezeArray__ arr w  of (# _, r #) -> r
rmfile ./lib/jhc/Jhc/Array.hs
hunk ./lib/jhc/jhc.yaml 27
-        - Jhc.Array
addfile ./regress/tests/1_typecheck/2_pass/InstTest.hs
hunk ./regress/tests/1_typecheck/2_pass/InstTest.hs 1
+{-# LANGUAGE M4 #-}
+
+m4_define({{m4_for}},{{m4_ifelse($#,0,{{{{$0}}}},{{m4_ifelse(m4_eval($2<=$3),1,
+{{m4_pushdef({{$1}},$2)$4{{}}m4_popdef({{$1}})$0({{$1}},m4_incr($2),$3,{{$4}})}})}})}})
+
+m4_define({{m4_foreach}},{{m4_ifelse(m4_eval($#>2),1,
+{{m4_pushdef({{$1}},{{$3}})$2{{}}m4_popdef({{$1}})m4_dnl
+{{}}m4_ifelse(m4_eval($#>3),1,{{$0({{$1}},{{$2}},m4_shift(m4_shift(m4_shift($@))))}})}})}})
+
+m4_define(checkp,{{ck_$1_$3 = (id :: $1 a => a -> a) undefined :: $2}})
+m4_define(check,checkp($1,$2,$2))
+
+m4_foreach(t,{{check(Eq,t)
+}},Int,Integer,Char,Float,Double,Bool,Ordering)
+
+m4_foreach(t,{{check(Ord,t)
+}},Int,Integer,Char,Float,Double,Bool,Ordering)
+
+m4_foreach(t,{{check(Num,t)
+}},Int,Integer,Float,Double)
+
+m4_foreach(t,{{check(Show,t)
+}},Int,Integer,Char,Float,Double,Bool,Ordering)
+
+checkp(Eq,(Char,()),Tup2)
+checkp(Ord,(Char,()),Tup2)
+
+checkp(Bounded,(),Unit)
+check(Bounded,Int)
+check(Bounded,Char)
+check(Bounded,Bool)
+check(Bounded,Ordering)
+
+main :: IO ()
+main = return ()
addfile ./regress/tests/3_io/Array.expected.stdout
hunk ./regress/tests/3_io/Array.expected.stdout 1
+abcdefghijklmnopqrstuvwxyz
+abcdefghijklmnopqrstuvwxyz
+[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25]
+"abcdefghijklmnopqrstuvwxyz"
+[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26]
+abcdefghijklmnopqrstuvwxyz
addfile ./regress/tests/3_io/Array.hs
hunk ./regress/tests/3_io/Array.hs 1
+import Data.Array
+
+
+abcs = ['a' .. 'z']
+
+abcs' = listArray (0,length abcs - 1) abcs
+abcs'' =  listArray (1,length abcs) abcs
+
+main = do
+    putStrLn abcs
+    putStrLn (elems abcs')
+    print (indices abcs')
+    print (elems abcs'')
+    print (indices abcs'')
+    putStrLn abcs
+
hunk ./src/E/PrimDecode.hs 45
+utup1 ~([] :-> t1) = [] :-> BTup [t1]
+array = hash
hunk ./src/E/PrimDecode.hs 69
+    , "newArray__"     ==> hash +> star +> state +> utup state array
+    , "newBlankArray__"==> hash +> state +> utup state array
+    , "copyArray__"    ==> hash +> hash +> hash +> array +> array +> state +> state
+    , "readArray__"    ==> array +> hash +> state +> utup state star
+    , "writeArray__"   ==> array +> hash +> star +> state +> state
+    , "indexArray__"   ==> array +> hash +> utup1 star
hunk ./src/Grin/FromE.hs 68
-    (tc_Ref__,TyPtr tyINode),
-    (tc_Array__,TyPtr tyINode),
hunk ./src/Grin/FromE.hs 409
-        -- references
-        f "newRef__" [v,_] = do
-            let [v'] = args [v]
-            return $ Alloc { expValue = v', expCount = toUnVal (1::Int), expRegion = region_heap, expInfo = mempty }
-        f "readRef__" [r,_] = do
-            let [r'] = args [r]
-            --return $ Fetch (Index r' (toUnVal (0::Int)))
-            return $ BaseOp PeekVal [Index r' (toUnVal (0::Int))]
-        f "writeRef__" [r,v,_] = do
-            let [r',v'] = args [r,v]
-            return $ BaseOp PokeVal [r',v']
-
hunk ./src/Grin/FromE.hs 410
-        f "newMutArray__" [v,def,_] = do
+        f "newArray__" [v,def,_] = do
hunk ./src/Grin/FromE.hs 413
-        f "newBlankMutArray__" [v,_] = do
+        f "newBlankArray__" [v,_] = do
hunk ./src/Grin/FromE.hs 426
-
-        f ft [v,_]  | ft `elem` ["unsafeFreezeArray__", "unsafeThawArray__"] = do
-            let [v'] = args [v]
-            return $ Return [v']
hunk ./src/data/names.txt 7
-Ref__      Data.IORef.Ref__
-MutArray__ Jhc.Array.MutArray__
+MutArray__ Jhc.Prim.Array.MutArray_
hunk ./src/data/names.txt 14
-Array__    Jhc.Array.Array__