imperative-edsl 0.6 → 0.7

raw patch · 7 files changed

+130/−108 lines, 7 filesdep ~mainland-prettyPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: mainland-pretty

API changes (from Hackage documentation)

Files

• examples/Concurrent.hs +3/−3
• imperative-edsl.cabal +2/−4
• src/Language/Embedded/Concurrent/CMD.hs +19/−2
• src/Language/Embedded/Imperative/Backend/C.hs +24/−16
• src/Language/Embedded/Imperative/CMD.hs +49/−45
• src/Language/Embedded/Imperative/Frontend.hs +10/−15
• tests/Imperative.hs +23/−23

@@ -97,12 +97,12 @@   b <- readChan c   printf "%d %d\n" a b -  sent :: Arr Int8 Int32 <- initArr [ 12, 34 ]+  sent :: Arr Int8 Int32 <- constArr [ 12, 34 ]   writeChanBuf c (0 :: CExp Int8) 2 sent   received <- newArr (2 :: CExp Int8)   readChanBuf c (0 :: CExp Int8) 2 received-  a <- getArr 0 received-  b <- getArr 1 received+  a <- getArr received 0+  b <- getArr received 1   printf "%d %d\n" a b    writeChan' c (67 :: CExp Word8)

@@ -1,12 +1,10 @@ name:                imperative-edsl-version:             0.6+version:             0.7 synopsis:            Deep embedding of imperative programs with code generation description:         Deep embedding of imperative programs with code generation.                      .                      The main module for users who want to write imperative-                     programs is "Language.Embedded.Imperative" (and optionally-                     "Language.Embedded.CExp" which provides a simple expression-                     language).+                     programs is "Language.Embedded.Imperative".                      .                      Examples can be found in the @examples@ directory. license:             BSD3

@@ -27,6 +27,8 @@ import Data.Ix (Ix) import Data.Maybe (fromMaybe) +import Control.Monads+import Language.Embedded.Traversal import Language.Embedded.Expression import Language.Embedded.Imperative.CMD import Language.Embedded.Imperative (getArr, setArr)@@ -150,6 +152,12 @@   hbimap _ _ (Wait tid)     = Wait tid   hbimap _ g (Sleep us)     = Sleep $ g us +instance DryInterp ThreadCMD where+  dryInterp (ForkWithId _) = liftM TIDComp $ freshStr "t"+  dryInterp (Kill _)       = return ()+  dryInterp (Wait _)       = return ()+  dryInterp (Sleep _)      = return ()+ instance (ThreadCMD :<: instr) => Reexpressible ThreadCMD instr env where   reexpressInstrEnv reexp (ForkWithId p) = ReaderT $ \env ->       singleInj $ ForkWithId (flip runReaderT env . p)@@ -175,6 +183,15 @@   hbimap _ _ (CloseChan c    )    = CloseChan c   hbimap _ _ (ReadOK c)           = ReadOK c +instance DryInterp ChanCMD where+  dryInterp (NewChan _)         = liftM ChanComp $ freshStr "chan"+  dryInterp (ReadOne _)         = liftM ValComp $ freshStr "v"+  dryInterp (ReadChan _ _ _ _)  = liftM ValComp $ freshStr "v"+  dryInterp (WriteOne _ _)      = liftM ValComp $ freshStr "v"+  dryInterp (WriteChan _ _ _ _) = liftM ValComp $ freshStr "v"+  dryInterp (CloseChan _)       = return ()+  dryInterp (ReadOK _)          = liftM ValComp $ freshStr "v"+ instance (ChanCMD :<: instr) => Reexpressible ChanCMD instr env where   reexpressInstrEnv reexp (NewChan sz) =       lift . singleInj . NewChan =<< mapSizeExpA reexp sz@@ -221,7 +238,7 @@   xs <- Chan.readChan c $ fromIntegral (len' - off')   let xs' = map convertDynamic xs   interpretBi id $ forM_ (zip [off' .. ] xs') $ \(i, x) -> do-    setArr (return i) (return x) arr :: Program ArrCMD (Param2 IO pred) ()+    setArr arr (return i) (return x) :: Program ArrCMD (Param2 IO pred) ()   ValRun <$> Chan.lastReadOK c runChanCMD (WriteOne (ChanRun c) x) =   ValRun <$> (Chan.writeChan c . return . toDyn =<< x)@@ -229,7 +246,7 @@   off' <- off   len' <- len   xs <- interpretBi id $ forM [off' .. off' + len' - 1] $ \i -> do-    getArr (return i) arr :: Program ArrCMD (Param2 IO pred) (IO el)+    getArr arr (return i) :: Program ArrCMD (Param2 IO pred) (IO el)   ValRun <$> (Chan.writeChan c =<< map toDyn <$> sequence xs) runChanCMD (CloseChan (ChanRun c)) = Chan.closeChan c runChanCMD (ReadOK    (ChanRun c)) = ValRun <$> Chan.lastReadOK c

@@ -83,15 +83,15 @@ compArrCMD :: forall exp ct a. (CompExp exp, CompTypeClass ct) =>     ArrCMD (Param3 CGen exp ct) a -> CGen a compArrCMD cmd@(NewArr base size) = compC_CMD (NewCArr base Nothing size :: C_CMD (Param3 CGen exp ct) a)-compArrCMD cmd@(InitArr base as) = compC_CMD (InitCArr base Nothing as   :: C_CMD (Param3 CGen exp ct) a)-compArrCMD cmd@(GetArr expi arr) = do+compArrCMD cmd@(ConstArr base as) = compC_CMD (ConstCArr base Nothing as :: C_CMD (Param3 CGen exp ct) a)+compArrCMD cmd@(GetArr arr expi) = do     v <- freshVar (proxyPred cmd)     i <- compExp expi     touchVar $ BaseArrOf arr  -- explanation above     touchVar arr     addStm [cstm| $id:v = $id:arr[ $i ]; |]     return v-compArrCMD (SetArr expi expv arr) = do+compArrCMD (SetArr arr expi expv) = do     v <- compExp expv     i <- compExp expi     touchVar $ BaseArrOf arr  -- explanation above@@ -121,13 +121,17 @@     ControlCMD (Param3 CGen exp ct) a -> CGen a compControlCMD (If c t f) = do     cc <- compExp c-    ct <- inNewBlock_ t-    cf <- inNewBlock_ f-    case (ct, cf) of-      ([],[]) -> return ()-      (_ ,[]) -> addStm [cstm| if (   $cc) {$items:ct} |]-      ([],_ ) -> addStm [cstm| if ( ! $cc) {$items:cf} |]-      (_ ,_ ) -> addStm [cstm| if (   $cc) {$items:ct} else {$items:cf} |]+    case cc of+      C.Var (C.Id "true"  _) _  -> t+      C.Var (C.Id "false"  _) _ -> f+      _ -> do+        ct <- inNewBlock_ t+        cf <- inNewBlock_ f+        case (ct, cf) of+          ([],[]) -> return ()+          (_ ,[]) -> addStm [cstm| if (   $cc) {$items:ct} |]+          ([],_ ) -> addStm [cstm| if ( ! $cc) {$items:cf} |]+          (_ ,_ ) -> addStm [cstm| if (   $cc) {$items:ct} else {$items:cf} |] compControlCMD (While cont body) = do     s <- get     noop <- do@@ -173,11 +177,15 @@  compPtrCMD :: PtrCMD (Param3 prog exp pred) a -> CGen a compPtrCMD (SwapPtr a b) = do-    sym <- gensym "tmp"-    addLocal [cdecl| void * $id:sym; |]-    addStm   [cstm| $id:sym = $id:a; |]-    addStm   [cstm| $id:a = $id:b; |]-    addStm   [cstm| $id:b = $id:sym; |]+    let swap_ptr =+          "#define swap_ptr(a,b) do {void* TmP=a; a=b; b=TmP;} while (0)"+      -- See this solution on the use of `do{}while(0)`:+      -- <http://stackoverflow.com/a/3982397/1105347>+      --+      -- The name "TmP" is to make it very unlikely to have the same name as `a`+      -- or `b`.+    addGlobal [cedecl| $esc:swap_ptr |]+    addStm [cstm| swap_ptr($id:a, $id:b); |]  compIOMode :: IOMode -> String compIOMode ReadMode      = "r"@@ -249,7 +257,7 @@           _ -> addItem [citem| $ty:t $id:sym'[ $n ]; |]         addItem [citem| $ty:t * $id:sym = $id:sym'; |]  -- explanation at 'compArrCMD'     return $ ArrComp sym-compC_CMD cmd@(InitCArr base align as) = do+compC_CMD cmd@(ConstCArr base align as) = do     sym <- gensym base     let sym' = '_':sym     t   <- compType (proxyPred cmd) (proxyArg cmd)

@@ -88,7 +88,7 @@ data Ref a     = RefComp VarId     | RefRun (IORef a)-  deriving Typeable+  deriving (Eq, Typeable)  instance ToIdent (Ref a) where toIdent (RefComp r) = C.Id r @@ -152,13 +152,13 @@     = ArrComp VarId     | ArrRun (IORef (IOArray i a))         -- The `IORef` is needed in order to make the `IsPointer` instance-  deriving Typeable+  deriving (Eq, Typeable)  -- | Immutable array data IArr i a     = IArrComp VarId     | IArrRun (Array i a)-  deriving (Eq, Show, Typeable)+  deriving (Show, Typeable)  -- In a way, it's not terribly useful to have `Arr` parameterized on the index -- type, since it's required to be an integer type, and it doesn't really matter@@ -182,11 +182,11 @@ -- | Commands for mutable arrays data ArrCMD fs a   where-    NewArr  :: (pred a, Integral i, Ix i) => String -> exp i -> ArrCMD (Param3 prog exp pred) (Arr i a)-    InitArr :: (pred a, Integral i, Ix i) => String -> [a] -> ArrCMD (Param3 prog exp pred) (Arr i a)-    GetArr  :: (pred a, Integral i, Ix i) => exp i -> Arr i a -> ArrCMD (Param3 prog exp pred) (Val a)-    SetArr  :: (pred a, Integral i, Ix i) => exp i -> exp a -> Arr i a -> ArrCMD (Param3 prog exp pred) ()-    CopyArr :: (pred a, Integral i, Ix i) => (Arr i a, exp i) -> (Arr i a, exp i) -> exp i -> ArrCMD (Param3 prog exp pred) ()+    NewArr   :: (pred a, Integral i, Ix i) => String -> exp i -> ArrCMD (Param3 prog exp pred) (Arr i a)+    ConstArr :: (pred a, Integral i, Ix i) => String -> [a] -> ArrCMD (Param3 prog exp pred) (Arr i a)+    GetArr   :: (pred a, Integral i, Ix i) => Arr i a -> exp i -> ArrCMD (Param3 prog exp pred) (Val a)+    SetArr   :: (pred a, Integral i, Ix i) => Arr i a -> exp i -> exp a -> ArrCMD (Param3 prog exp pred) ()+    CopyArr  :: (pred a, Integral i, Ix i) => (Arr i a, exp i) -> (Arr i a, exp i) -> exp i -> ArrCMD (Param3 prog exp pred) ()       -- The arrays are paired with their offset     UnsafeFreezeArr :: (pred a, Integral i, Ix i) => Arr i a -> ArrCMD (Param3 prog exp pred) (IArr i a)     UnsafeThawArr   :: (pred a, Integral i, Ix i) => IArr i a -> ArrCMD (Param3 prog exp pred) (Arr i a)@@ -199,7 +199,7 @@ instance HFunctor ArrCMD   where     hfmap _ (NewArr base n)       = NewArr base n-    hfmap _ (InitArr base as)     = InitArr base as+    hfmap _ (ConstArr base as)    = ConstArr base as     hfmap _ (GetArr i arr)        = GetArr i arr     hfmap _ (SetArr i a arr)      = SetArr i a arr     hfmap _ (CopyArr a1 a2 l)     = CopyArr a1 a2 l@@ -209,9 +209,9 @@ instance HBifunctor ArrCMD   where     hbimap _ f (NewArr base n)             = NewArr base (f n)-    hbimap _ _ (InitArr base as)           = InitArr base as-    hbimap _ f (GetArr i arr)              = GetArr (f i) arr-    hbimap _ f (SetArr i a arr)            = SetArr (f i) (f a) arr+    hbimap _ _ (ConstArr base as)          = ConstArr base as+    hbimap _ f (GetArr arr i)              = GetArr arr (f i)+    hbimap _ f (SetArr arr i a)            = SetArr arr (f i) (f a)     hbimap _ f (CopyArr (a1,o1) (a2,o2) l) = CopyArr (a1, f o1) (a2, f o2) (f l)     hbimap _ _ (UnsafeFreezeArr arr)       = UnsafeFreezeArr arr     hbimap _ _ (UnsafeThawArr arr)         = UnsafeThawArr arr@@ -219,9 +219,9 @@ instance (ArrCMD :<: instr) => Reexpressible ArrCMD instr env   where     reexpressInstrEnv reexp (NewArr base n)       = lift . singleInj . NewArr base =<< reexp n-    reexpressInstrEnv reexp (InitArr base as)     = lift $ singleInj $ InitArr base as-    reexpressInstrEnv reexp (GetArr i arr)        = lift . singleInj . flip GetArr arr =<< reexp i-    reexpressInstrEnv reexp (SetArr i a arr)      = do i' <- reexp i; a' <- reexp a; lift $ singleInj $ SetArr i' a' arr+    reexpressInstrEnv reexp (ConstArr base as)    = lift $ singleInj $ ConstArr base as+    reexpressInstrEnv reexp (GetArr arr i)        = lift . singleInj . GetArr arr =<< reexp i+    reexpressInstrEnv reexp (SetArr arr i a)      = do i' <- reexp i; a' <- reexp a; lift $ singleInj $ SetArr arr i' a'     reexpressInstrEnv reexp (UnsafeFreezeArr arr) = lift $ singleInj $ UnsafeFreezeArr arr     reexpressInstrEnv reexp (UnsafeThawArr arr)   = lift $ singleInj $ UnsafeThawArr arr     reexpressInstrEnv reexp (CopyArr (a1,o1) (a2,o2) l) = do@@ -232,11 +232,11 @@  instance DryInterp ArrCMD   where-    dryInterp (NewArr base _)  = liftM ArrComp $ freshStr base-    dryInterp (InitArr base _) = liftM ArrComp $ freshStr base-    dryInterp (GetArr _ _)     = liftM ValComp $ freshStr "v"-    dryInterp (SetArr _ _ _)   = return ()-    dryInterp (CopyArr _ _ _)  = return ()+    dryInterp (NewArr base _)   = liftM ArrComp $ freshStr base+    dryInterp (ConstArr base _) = liftM ArrComp $ freshStr base+    dryInterp (GetArr _ _)      = liftM ValComp $ freshStr "v"+    dryInterp (SetArr _ _ _)    = return ()+    dryInterp (CopyArr _ _ _)   = return ()     dryInterp (UnsafeFreezeArr (ArrComp arr)) = return (IArrComp arr)     dryInterp (UnsafeThawArr (IArrComp arr))  = return (ArrComp arr) @@ -347,6 +347,10 @@         writeIORef arr1 arr2'         writeIORef arr2 arr1' +instance IsPointer (Ptr a)+  where+    runSwapPtr = error "cannot run SwapPtr for Ptr"+ data PtrCMD fs a   where     SwapPtr :: IsPointer a => a -> a -> PtrCMD (Param3 prog exp pred) ()@@ -372,7 +376,7 @@ data Handle     = HandleComp VarId     | HandleRun IO.Handle-  deriving Typeable+  deriving (Eq, Show, Typeable)  instance ToIdent Handle where toIdent (HandleComp h) = C.Id h @@ -489,7 +493,7 @@     , objectType :: String     , objectId   :: VarId     }-  deriving (Eq, Show, Ord, Typeable)+  deriving (Eq, Show, Typeable)  instance ToIdent Object where toIdent (Object _ _ o) = C.Id o @@ -569,10 +573,10 @@  data C_CMD fs a   where-    NewCArr  :: (pred a, Integral i, Ix i) => String -> Maybe i -> exp i -> C_CMD (Param3 prog exp pred) (Arr i a)-    InitCArr :: (pred a, Integral i, Ix i) => String -> Maybe i -> [a] -> C_CMD (Param3 prog exp pred) (Arr i a)-    NewPtr   :: pred a => String -> C_CMD (Param3 prog exp pred) (Ptr a)-    PtrToArr :: Ptr a -> C_CMD (Param3 prog exp pred) (Arr i a)+    NewCArr   :: (pred a, Integral i, Ix i) => String -> Maybe i -> exp i -> C_CMD (Param3 prog exp pred) (Arr i a)+    ConstCArr :: (pred a, Integral i, Ix i) => String -> Maybe i -> [a] -> C_CMD (Param3 prog exp pred) (Arr i a)+    NewPtr    :: pred a => String -> C_CMD (Param3 prog exp pred) (Ptr a)+    PtrToArr  :: Ptr a -> C_CMD (Param3 prog exp pred) (Arr i a)     NewObject         :: String  -- Base name         -> String  -- Type@@ -589,7 +593,7 @@ instance HFunctor C_CMD   where     hfmap _ (NewCArr base al n)       = NewCArr base al n-    hfmap _ (InitCArr base al as)     = InitCArr base al as+    hfmap _ (ConstCArr base al as)    = ConstCArr base al as     hfmap _ (NewPtr base)             = NewPtr base     hfmap _ (PtrToArr p)              = PtrToArr p     hfmap _ (NewObject base p t)      = NewObject base p t@@ -604,7 +608,7 @@ instance HBifunctor C_CMD   where     hbimap _ f (NewCArr base al n)       = NewCArr base al (f n)-    hbimap _ _ (InitCArr base al as)     = InitCArr base al as+    hbimap _ _ (ConstCArr base al as)    = ConstCArr base al as     hbimap _ _ (NewPtr base)             = NewPtr base     hbimap _ _ (PtrToArr p)              = PtrToArr p     hbimap _ _ (NewObject base p t)      = NewObject base p t@@ -619,7 +623,7 @@ instance (C_CMD :<: instr) => Reexpressible C_CMD instr env   where     reexpressInstrEnv reexp (NewCArr base al n)       = lift . singleInj . NewCArr base al =<< reexp n-    reexpressInstrEnv reexp (InitCArr base al as)     = lift $ singleInj $ InitCArr base al as+    reexpressInstrEnv reexp (ConstCArr base al as)    = lift $ singleInj $ ConstCArr base al as     reexpressInstrEnv reexp (NewPtr base)             = lift $ singleInj $ NewPtr base     reexpressInstrEnv reexp (PtrToArr p)              = lift $ singleInj $ PtrToArr p     reexpressInstrEnv reexp (NewObject base p t)      = lift $ singleInj $ NewObject base p t@@ -634,7 +638,7 @@ instance DryInterp C_CMD   where     dryInterp (NewCArr base _ _)     = liftM ArrComp $ freshStr base-    dryInterp (InitCArr base _ _)    = liftM ArrComp $ freshStr base+    dryInterp (ConstCArr base _ _)   = liftM ArrComp $ freshStr base     dryInterp (NewPtr base)          = liftM PtrComp $ freshStr base     dryInterp (PtrToArr (PtrComp p)) = return $ ArrComp p     dryInterp (NewObject base t p)   = liftM (Object p t) $ freshStr base@@ -664,9 +668,9 @@     n'  <- n     arr <- newArray_ (0, fromIntegral n'-1)     ArrRun <$> newIORef arr-runArrCMD (InitArr _ as) =+runArrCMD (ConstArr _ as) =     fmap ArrRun . newIORef =<< newListArray (0, genericLength as - 1) as-runArrCMD (GetArr i (ArrRun arr)) = do+runArrCMD (GetArr (ArrRun arr) i) = do     arr'  <- readIORef arr     i'    <- i     (l,h) <- getBounds arr'@@ -676,7 +680,7 @@                 ++ " out of bounds "                 ++ show (toInteger l, toInteger h)       else ValRun <$> readArray arr' i'-runArrCMD (SetArr i a (ArrRun arr)) = do+runArrCMD (SetArr (ArrRun arr) i a) = do     arr'  <- readIORef arr     i'    <- i     a'    <- a@@ -784,18 +788,18 @@ runFileCMD (FEof h) = fmap ValRun $ IO.hIsEOF $ runHandle h  runC_CMD :: forall pred a. C_CMD (Param3 IO IO pred) a -> IO a-runC_CMD (NewCArr base _ n)   = runArrCMD (NewArr base n   :: ArrCMD (Param3 IO IO pred) a)-runC_CMD (InitCArr base _ as) = runArrCMD (InitArr base as :: ArrCMD (Param3 IO IO pred) a)-runC_CMD (NewPtr base)        = error $ "cannot run programs involving newPtr (base name " ++ base ++ ")"-runC_CMD (PtrToArr p)         = error "cannot run programs involving ptrToArr"-runC_CMD (NewObject base _ _) = error $ "cannot run programs involving newObject (base name " ++ base ++ ")"-runC_CMD (AddInclude _)       = return ()-runC_CMD (AddDefinition _)    = return ()-runC_CMD (AddExternFun _ _ _) = return ()-runC_CMD (AddExternProc _ _)  = return ()-runC_CMD (CallFun _ _)        = error "cannot run programs involving callFun"-runC_CMD (CallProc _ _ _)     = error "cannot run programs involving callProc"-runC_CMD (InModule _ prog)    = prog+runC_CMD (NewCArr base _ n)    = runArrCMD (NewArr base n    :: ArrCMD (Param3 IO IO pred) a)+runC_CMD (ConstCArr base _ as) = runArrCMD (ConstArr base as :: ArrCMD (Param3 IO IO pred) a)+runC_CMD (NewPtr base)         = error $ "cannot run programs involving newPtr (base name " ++ base ++ ")"+runC_CMD (PtrToArr p)          = error "cannot run programs involving ptrToArr"+runC_CMD (NewObject base _ _)  = error $ "cannot run programs involving newObject (base name " ++ base ++ ")"+runC_CMD (AddInclude _)        = return ()+runC_CMD (AddDefinition _)     = return ()+runC_CMD (AddExternFun _ _ _)  = return ()+runC_CMD (AddExternProc _ _)   = return ()+runC_CMD (CallFun _ _)         = error "cannot run programs involving callFun"+runC_CMD (CallProc _ _ _)      = error "cannot run programs involving callProc"+runC_CMD (InModule _ prog)     = prog  instance InterpBi RefCMD     IO (Param1 pred) where interpBi = runRefCMD instance InterpBi ArrCMD     IO (Param1 pred) where interpBi = runArrCMD

@@ -115,21 +115,21 @@     -> ProgramT instr (Param2 exp pred) m (Arr i a) newNamedArr base len = singleInj (NewArr base len) --- | Create and initialize an array-initArr :: (pred a, Integral i, Ix i, ArrCMD :<: instr)+-- | Create an array and initialize it with a constant list+constArr :: (pred a, Integral i, Ix i, ArrCMD :<: instr)     => [a]  -- ^ Initial contents     -> ProgramT instr (Param2 exp pred) m (Arr i a)-initArr = initNamedArr "a"+constArr = constNamedArr "a" --- | Create and initialize a named array+-- | Create a named array and initialize it with a constant list -- -- The provided base name may be appended with a unique identifier to avoid name -- collisions.-initNamedArr :: (pred a, Integral i, Ix i, ArrCMD :<: instr)+constNamedArr :: (pred a, Integral i, Ix i, ArrCMD :<: instr)     => String  -- ^ Base name     -> [a]     -- ^ Initial contents     -> ProgramT instr (Param2 exp pred) m (Arr i a)-initNamedArr base init = singleInj (InitArr base init)+constNamedArr base init = singleInj (ConstArr base init)  -- | Get an element of an array getArr@@ -141,13 +141,13 @@        , ArrCMD :<: instr        , Monad m        )-    => exp i -> Arr i a -> ProgramT instr (Param2 exp pred) m (exp a)-getArr i arr = fmap valToExp $ singleInj $ GetArr i arr+    => Arr i a -> exp i -> ProgramT instr (Param2 exp pred) m (exp a)+getArr arr i = fmap valToExp $ singleInj $ GetArr arr i  -- | Set an element of an array setArr :: (pred a, Integral i, Ix i, ArrCMD :<: instr) =>-    exp i -> exp a -> Arr i a -> ProgramT instr (Param2 exp pred) m ()-setArr i a arr = singleInj (SetArr i a arr)+    Arr i a -> exp i -> exp a -> ProgramT instr (Param2 exp pred) m ()+setArr arr i a = singleInj (SetArr arr i a)  -- | Copy the contents of an array to another array. The number of elements to -- copy must not be greater than the number of allocated elements in either@@ -195,11 +195,6 @@ unsafeThawArr :: (pred a, Integral i, Ix i, ArrCMD :<: instr) =>     IArr i a -> ProgramT instr (Param2 exp pred) m (Arr i a) unsafeThawArr arr = singleInj $ UnsafeThawArr arr---- | Create and initialize an immutable array-initIArr :: (pred a, Integral i, Ix i, ArrCMD :<: instr, Monad m) =>-    [a] -> ProgramT instr (Param2 exp pred) m (IArr i a)-initIArr = unsafeFreezeArr <=< initArr   

@@ -87,85 +87,85 @@ testCopyArr1 = do     arr1 :: Arr Word32 Int32 <- newArr (10 :: CExp Word32)     arr2 :: Arr Word32 Int32 <- newArr (10 :: CExp Word32)-    sequence_ [setArr i (i2n i+10) arr1 | i' <- [0..9], let i = fromInteger i']+    sequence_ [setArr arr1 i (i2n i+10) | i' <- [0..9], let i = fromInteger i']     copyArr (arr2,0) (arr1,0) 10-    sequence_ [getArr i arr2 >>= printf "%d " . (*3) | i' <- [0..9], let i = fromInteger i']+    sequence_ [getArr arr2 i >>= printf "%d " . (*3) | i' <- [0..9], let i = fromInteger i']     printf "\n"  testCopyArr2 :: Prog () testCopyArr2 = do     arr1 :: Arr Word32 Int32 <- newArr (20 :: CExp Word32)     arr2 :: Arr Word32 Int32 <- newArr (20 :: CExp Word32)-    sequence_ [setArr i (i2n i+10) arr1 | i' <- [0..19], let i = fromInteger i']+    sequence_ [setArr arr1 i (i2n i+10) | i' <- [0..19], let i = fromInteger i']     copyArr (arr2,10) (arr1,5) 10-    sequence_ [getArr i arr2 >>= printf "%d " . (*3) | i' <- [10..19], let i = fromInteger i']+    sequence_ [getArr arr2 i >>= printf "%d " . (*3) | i' <- [10..19], let i = fromInteger i']     printf "\n"  testArr2 :: Prog () testArr2 = do     n <- fget stdin     arr :: Arr Word32 Int32 <- newArr n  -- Array of dynamic length-    sequence_ [setArr (i2n i) i arr | i' <- [0..3], let i = fromInteger i']-    sequence_ [getArr i arr >>= printf "%d " . (*3) | i' <- [0..3], let i = fromInteger i']+    sequence_ [setArr arr (i2n i) i | i' <- [0..3], let i = fromInteger i']+    sequence_ [getArr arr i >>= printf "%d " . (*3) | i' <- [0..3], let i = fromInteger i']     printf "\n"     return ()  testArr3 :: Prog () testArr3 = do-    arr :: Arr Word32 Int32 <- initArr [8,7,6,5]-    sequence_ [getArr i arr >>= printf "%d " . (*3) | i' <- [0..3], let i = fromInteger i']+    arr :: Arr Word32 Int32 <- constArr [8,7,6,5]+    sequence_ [getArr arr i >>= printf "%d " . (*3) | i' <- [0..3], let i = fromInteger i']     printf "\n"     return ()  testArr4 :: Prog () testArr4 = do-    arr :: Arr Word32 Int32 <- initArr [8,7,6,5]+    arr :: Arr Word32 Int32 <- constArr [8,7,6,5]     iarr <- freezeArr arr 4     sequence_ [printf "%d " $ iarr #! i | i' <- [0..3], let i = fromInteger i']     printf "\n"  testArr5 :: Prog () testArr5 = do-    arr :: Arr Word32 Int32 <- initArr [8,7,6,5]+    arr :: Arr Word32 Int32 <- constArr [8,7,6,5]     iarr <- unsafeFreezeArr arr     sequence_ [printf "%d " $ iarr #! i | i' <- [0..3], let i = fromInteger i']     printf "\n"  testArr6 :: Prog () testArr6 = do-    arr :: Arr Word32 Int32 <- initArr [8,7,6,5]+    arr :: Arr Word32 Int32 <- constArr [8,7,6,5]     iarr <- unsafeFreezeArr arr     arr2 <- unsafeThawArr iarr-    sequence_ [getArr i arr2 >>= printf "%d " | i <- map fromInteger [0..3]]+    sequence_ [getArr arr2 i >>= printf "%d " | i <- map fromInteger [0..3]]     printf "\n"  testArr7 :: Prog () testArr7 = do-    arr :: Arr Word32 Int32 <- initArr [8,7,6,5]+    arr :: Arr Word32 Int32 <- constArr [8,7,6,5]     iarr <- freezeArr arr 4     arr2 <- thawArr iarr 4-    sequence_ [getArr i arr2 >>= printf "%d " | i <- map fromInteger [0..3]]+    sequence_ [getArr arr2 i >>= printf "%d " | i <- map fromInteger [0..3]]     printf "\n"  testSwap1 :: Prog () testSwap1 = do-    arr1 :: Arr Word32 Int32 <- initArr [1,2,3,4]-    arr2 :: Arr Word32 Int32 <- initArr [11,12,13,14]+    arr1 :: Arr Word32 Int32 <- constArr [1,2,3,4]+    arr2 :: Arr Word32 Int32 <- constArr [11,12,13,14]     unsafeSwap arr1 arr2-    sequence_ [getArr i arr1 >>= printf "%d " | i <- map fromInteger [0..3]]+    sequence_ [getArr arr1 i >>= printf "%d " | i <- map fromInteger [0..3]]     printf "\n"  testSwap2 :: Prog () testSwap2 = do-    arr1 :: Arr Word32 Int32 <- initArr [1,2,3,4]+    arr1 :: Arr Word32 Int32 <- constArr [1,2,3,4]     n <- fget stdin     arr2 :: Arr Word32 Int32 <- newArr n     copyArr (arr2,0) (arr1,0) 4-    setArr 2 22 arr2+    setArr arr2 2 22     unsafeSwap arr1 arr2-    sequence_ [getArr i arr1 >>= printf "%d " | i <- map fromInteger [0..3]]+    sequence_ [getArr arr1 i >>= printf "%d " | i <- map fromInteger [0..3]]     printf "\n"-    sequence_ [getArr i arr2 >>= printf "%d " | i <- map fromInteger [0..3]]+    sequence_ [getArr arr2 i >>= printf "%d " | i <- map fromInteger [0..3]]     printf "\n"  testIf1 :: Prog ()@@ -222,7 +222,7 @@     addInclude "<stdio.h>"     p :: Ptr Int32 <- newPtr     callProcAssign p "malloc" [valArg (100 :: CExp Word32)]-    arr :: Arr Word32 Int32 <- initArr [34,45,56,67,78]+    arr :: Arr Word32 Int32 <- constArr [34,45,56,67,78]     callProc "memcpy" [ptrArg p, arrArg arr, valArg (5*4 :: CExp Word32)]  -- sizeof(int32_t) = 4     callProc "printf" [strArg "%d\n", deref $ ptrArg p]     iarr :: IArr Word32 Int32 <- unsafeFreezeArr =<< ptrToArr p@@ -237,7 +237,7 @@     addDefinition ret_def     let v = 55 :: CExp Int32     r <- initRef (66 :: CExp Int32)-    a :: Arr Int32 Int32 <- initArr [234..300]+    a :: Arr Int32 Int32 <- constArr [234..300]     ia <- freezeArr a 10     p :: Ptr Int32 <- newPtr     o <- newObject "int" False