- indexify :: [a] -> [(Int, a)]
- indexify xs = zip [0..] xs
-
- BCO bco# <- newBCO insns_barr literals_barr ptrs_parr itbls_barr
-
- -- WAS: return (unsafeCoerce# bco#)
- case mkApUpd0# (unsafeCoerce# bco#) of
- (# final_bco #) -> return final_bco
-
+ newBCO insns_barr literals_barr ptrs_parr itbls_barr
+
+
+-- we recursively link any sub-BCOs while making the ptrs array
+mkPtrsArray :: ItblEnv -> ClosureEnv -> Int -> [BCOPtr] -> IO (Array Int HValue)
+mkPtrsArray ie ce n_ptrs ptrs = do
+ marr <- newArray_ (0, n_ptrs-1)
+ let
+ fill (BCOPtrName n) i = do
+ ptr <- lookupName ce n
+ unsafeWrite marr i ptr
+ fill (BCOPtrPrimOp op) i = do
+ ptr <- lookupPrimOp op
+ unsafeWrite marr i ptr
+ fill (BCOPtrBCO ul_bco) i = do
+ BCO bco# <- linkBCO' ie ce ul_bco
+ writeArrayBCO marr i bco#
+ zipWithM fill ptrs [0..]
+ unsafeFreeze marr
+
+newtype IOArray i e = IOArray (STArray RealWorld i e)
+
+instance HasBounds IOArray where
+ bounds (IOArray marr) = bounds marr
+
+instance MArray IOArray e IO where
+ newArray lu init = stToIO $ do
+ marr <- newArray lu init; return (IOArray marr)
+ newArray_ lu = stToIO $ do
+ marr <- newArray_ lu; return (IOArray marr)
+ unsafeRead (IOArray marr) i = stToIO (unsafeRead marr i)
+ unsafeWrite (IOArray marr) i e = stToIO (unsafeWrite marr i e)
+
+-- XXX HACK: we should really have a new writeArray# primop that takes a BCO#.
+writeArrayBCO :: IOArray Int a -> Int -> BCO# -> IO ()
+writeArrayBCO (IOArray (STArray _ _ marr#)) (I# i#) bco# = IO $ \s# ->
+ case (unsafeCoerce# writeArray#) marr# i# bco# s# of { s# ->
+ (# s#, () #) }