imperative-edsl 0.8.1 → 0.8.2

raw patch · 6 files changed

+104/−55 lines, 6 filesdep +constraintsdep ~containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: constraints

Dependency ranges changed: containers

API changes (from Hackage documentation)

Files

• imperative-edsl.cabal +4/−3
• src/Language/Embedded/Concurrent.hs +4/−4
• src/Language/Embedded/Concurrent/CMD.hs +2/−2
• src/Language/Embedded/Imperative/Backend/C.hs +15/−1
• src/Language/Embedded/Imperative/CMD.hs +51/−29
• src/Language/Embedded/Imperative/Frontend.hs +28/−16

@@ -1,5 +1,5 @@ name:                imperative-edsl-version:             0.8.1+version:             0.8.2 synopsis:            Deep embedding of imperative programs with code generation description:         Deep embedding of imperative programs with code generation.                      .@@ -86,7 +86,8 @@   build-depends:     array < 0.6,     base >=4 && <5,-    containers < 0.7,+    constraints >= 0.9,+    containers >= 0.5.10 && < 0.7,     data-default-class < 0.2,     deepseq < 1.5,     directory < 1.4,@@ -106,7 +107,7 @@       -- That version fixes overlap bugs     time >= 1.5.0.1 && < 1.12,     stm >= 2.4 && < 2.6-+       hs-source-dirs: src  test-suite Tests

@@ -106,7 +106,7 @@ --   The semantics are the same as for 'readChan', where "channel is empty" --   is defined as "channel contains less data than requested". --   Returns @False@ without reading any data if the channel is closed.-readChanBuf :: ( Typeable a, pred a+readChanBuf :: ( Typeable a, pred a, pred i                , Ix i, Integral i                , FreeExp exp, FreePred exp Bool                , ChanCMD :<: instr, Monad m )@@ -134,7 +134,7 @@ --   The semantics are the same as for 'writeChan', where "channel is full" --   is defined as "channel has insufficient free space to store all written --   data".-writeChanBuf :: ( Typeable a, pred a+writeChanBuf :: ( Typeable a, pred a, pred i                 , Ix i, Integral i                 , FreeExp exp, FreePred exp Bool                 , ChanCMD :<: instr, Monad m )@@ -184,7 +184,7 @@           -> ProgramT instr (Param2 exp pred) m (exp a) readChan' = fmap valToExp . singleInj . ReadOne -readChanBuf' :: ( Typeable a, pred a+readChanBuf' :: ( Typeable a, pred a, pred i                 , Ix i, Integral i                 , FreeExp exp, FreePred exp Bool                 , ChanCMD :<: instr, Monad m )@@ -203,7 +203,7 @@            -> ProgramT instr (Param2 exp pred) m (exp Bool) writeChan' c = fmap valToExp . singleInj . WriteOne c -writeChanBuf' :: ( Typeable a, pred a+writeChanBuf' :: ( Typeable a, pred a, pred i                  , Ix i, Integral i                  , FreeExp exp, FreePred exp Bool                  , ChanCMD :<: instr, Monad m )

@@ -133,10 +133,10 @@   WriteOne  :: (Typeable a, pred a)             => Chan t c -> exp a -> ChanCMD (Param3 prog exp pred) (Val Bool) -  ReadChan  :: (Typeable a, pred a, Ix i, Integral i)+  ReadChan  :: (Typeable a, pred a, pred i, Ix i, Integral i)             => Chan t c -> exp i -> exp i             -> Arr i a -> ChanCMD (Param3 prog exp pred) (Val Bool)-  WriteChan :: (Typeable a, pred a, Ix i, Integral i)+  WriteChan :: (Typeable a, pred a, pred i, Ix i, Integral i)             => Chan t c -> exp i -> exp i             -> Arr i a -> ChanCMD (Param3 prog exp pred) (Val Bool) 

@@ -13,6 +13,7 @@ #endif import Control.Monad.State import Data.Proxy+import Data.Loc  import Language.C.Quote.GCC import qualified Language.C.Syntax as C@@ -174,7 +175,10 @@     addInclude "<assert.h>"     c <- compExp cond     addStm [cstm| assert($c && $msg); |]-+compControlCMD (Hint _) = return ()+compControlCMD (Comment msg) = do+  addStm (C.EscStm ("/* " ++ msg ++ " */") noLoc)+       compPtrCMD :: PtrCMD (Param3 prog exp pred) a -> CGen a compPtrCMD (SwapPtr a b) = do     let swap_ptr =@@ -186,6 +190,16 @@       -- or `b`.     addGlobal [cedecl| $esc:swap_ptr |]     addStm [cstm| swap_ptr($id:a, $id:b); |]+compPtrCMD (SwapArr a b) = do+    let swap_arr =+          "#define swap_arr(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_arr |]+    addStm [cstm| swap_arr($id:a, $id:b); |]  compIOMode :: IOMode -> String compIOMode ReadMode      = "r"

@@ -182,14 +182,14 @@ -- | 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)-    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) ()+    NewArr   :: (pred a, pred i, Integral i, Ix i) => String -> exp i -> ArrCMD (Param3 prog exp pred) (Arr i a)+    ConstArr :: (pred a, pred i, Integral i, Ix i) => String -> [a] -> ArrCMD (Param3 prog exp pred) (Arr i a)+    GetArr   :: (pred a, pred i, Integral i, Ix i) => Arr i a -> exp i -> ArrCMD (Param3 prog exp pred) (Val a)+    SetArr   :: (pred a, pred i, Integral i, Ix i) => Arr i a -> exp i -> exp a -> ArrCMD (Param3 prog exp pred) ()+    CopyArr  :: (pred a, pred i, 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)+    UnsafeFreezeArr :: (pred a, pred i, Integral i, Ix i) => Arr i a -> ArrCMD (Param3 prog exp pred) (IArr i a)+    UnsafeThawArr   :: (pred a, pred i, Integral i, Ix i) => IArr i a -> ArrCMD (Param3 prog exp pred) (Arr i a) #if  __GLASGOW_HASKELL__>=708   deriving Typeable #endif@@ -277,11 +277,13 @@  data ControlCMD fs a   where-    If     :: exp Bool -> prog () -> prog () -> ControlCMD (Param3 prog exp pred) ()-    While  :: prog (exp Bool) -> prog () -> ControlCMD (Param3 prog exp pred) ()-    For    :: (pred i, Integral i) => IxRange (exp i) -> (Val i -> prog ()) -> ControlCMD (Param3 prog exp pred) ()-    Break  :: ControlCMD (Param3 prog exp pred) ()-    Assert :: exp Bool -> String -> ControlCMD (Param3 prog exp pred) ()+    If      :: exp Bool -> prog () -> prog () -> ControlCMD (Param3 prog exp pred) ()+    While   :: prog (exp Bool) -> prog () -> ControlCMD (Param3 prog exp pred) ()+    For     :: (pred i, Integral i) => IxRange (exp i) -> (Val i -> prog ()) -> ControlCMD (Param3 prog exp pred) ()+    Break   :: ControlCMD (Param3 prog exp pred) ()+    Assert  :: exp Bool -> String -> ControlCMD (Param3 prog exp pred) ()+    Hint    :: pred a => exp a -> ControlCMD (Param3 prog exp pred) ()+    Comment :: String -> ControlCMD (Param3 prog exp pred) ()  instance HFunctor ControlCMD   where@@ -290,6 +292,8 @@     hfmap f (For rng body)    = For rng (f . body)     hfmap _ Break             = Break     hfmap _ (Assert cond msg) = Assert cond msg+    hfmap _ (Hint exp)        = Hint exp+    hfmap _ (Comment msg)     = Comment msg  instance HBifunctor ControlCMD   where@@ -298,6 +302,8 @@     hbimap f g (For (lo,step,hi) body) = For (g lo, step, fmap g hi) (f . body)     hbimap _ _ Break                   = Break     hbimap _ g (Assert cond msg)       = Assert (g cond) msg+    hbimap _ g (Hint exp)              = Hint (g exp)+    hbimap _ _ (Comment msg)           = Comment msg  instance (ControlCMD :<: instr) => Reexpressible ControlCMD instr env   where@@ -316,6 +322,8 @@             For (lo',step,hi') (flip runReaderT env . body)     reexpressInstrEnv reexp Break             = lift $ singleInj Break     reexpressInstrEnv reexp (Assert cond msg) = lift . singleInj . flip Assert msg =<< reexp cond+    reexpressInstrEnv reexp (Hint exp)        = lift . singleInj . Hint =<< reexp exp+    reexpressInstrEnv reexp (Comment msg)     = lift $ singleInj (Comment msg)  instance DryInterp ControlCMD   where@@ -324,7 +332,9 @@     dryInterp (For _ _)    = return ()     dryInterp Break        = return ()     dryInterp (Assert _ _) = return ()-+    dryInterp (Hint _)     = return ()+    dryInterp (Comment _)  = return ()+       --------------------------------------------------------------------------------@@ -353,18 +363,29 @@  data PtrCMD fs a   where-    SwapPtr :: IsPointer a => a -> a -> PtrCMD (Param3 prog exp pred) ()+    SwapPtr :: Ptr a -> Ptr a -> PtrCMD (Param3 prog exp pred) ()+    SwapArr :: (Typeable i, Typeable a, pred i, pred a)+      => Arr i a -> Arr i a -> PtrCMD (Param3 prog exp pred) () -instance HFunctor   PtrCMD where hfmap _    (SwapPtr a b) = SwapPtr a b-instance HBifunctor PtrCMD where hbimap _ _ (SwapPtr a b) = SwapPtr a b+instance HFunctor   PtrCMD+  where+    hfmap _    (SwapPtr a b) = SwapPtr a b+    hfmap _    (SwapArr a b) = SwapArr a b+    +instance HBifunctor PtrCMD+  where+    hbimap _ _ (SwapPtr a b) = SwapPtr a b+    hbimap _ _ (SwapArr a b) = SwapArr a b  instance (PtrCMD :<: instr) => Reexpressible PtrCMD instr env   where     reexpressInstrEnv reexp (SwapPtr a b) = lift $ singleInj (SwapPtr a b)+    reexpressInstrEnv reexp (SwapArr a b) = lift $ singleInj (SwapArr a b)  instance DryInterp PtrCMD   where     dryInterp (SwapPtr _ _) = return ()+    dryInterp (SwapArr _ _) = return ()   @@ -388,18 +409,18 @@ stdout :: Handle stdout = HandleComp "stdout" -data PrintfArg exp+data PrintfArg exp pred   where-    PrintfArg :: Printf.PrintfArg a => exp a -> PrintfArg exp+    PrintfArg :: (Printf.PrintfArg a, pred a) => exp a -> PrintfArg exp pred  mapPrintfArg-    :: (forall a . exp1 a -> exp2 a)-    -> PrintfArg exp1 -> PrintfArg exp2+    :: (forall a . pred a => exp1 a -> exp2 a)+    -> PrintfArg exp1 pred -> PrintfArg exp2 pred mapPrintfArg f (PrintfArg exp) = PrintfArg (f exp)  mapPrintfArgM :: Monad m-    => (forall a . exp1 a -> m (exp2 a))-    -> PrintfArg exp1 -> m (PrintfArg exp2)+    => (forall a . pred a => exp1 a -> m (exp2 a))+    -> PrintfArg exp1 pred -> m (PrintfArg exp2 pred) mapPrintfArgM f (PrintfArg exp) = liftM PrintfArg (f exp)  -- | Values that can be printed\/scanned using @printf@\/@scanf@@@ -437,10 +458,10 @@  data FileCMD fs a   where-    FOpen   :: FilePath -> IOMode                  -> FileCMD (Param3 prog exp pred) Handle-    FClose  :: Handle                              -> FileCMD (Param3 prog exp pred) ()-    FEof    :: Handle                              -> FileCMD (Param3 prog exp pred) (Val Bool)-    FPrintf :: Handle -> String -> [PrintfArg exp] -> FileCMD (Param3 prog exp pred) ()+    FOpen   :: FilePath -> IOMode -> FileCMD (Param3 prog exp pred) Handle+    FClose  :: Handle -> FileCMD (Param3 prog exp pred) ()+    FEof    :: Handle -> FileCMD (Param3 prog exp pred) (Val Bool)+    FPrintf :: Handle -> String -> [PrintfArg exp pred] -> FileCMD (Param3 prog exp pred) ()     FGet    :: (pred a, Formattable a) => Handle   -> FileCMD (Param3 prog exp pred) (Val a)  instance HFunctor FileCMD@@ -573,8 +594,8 @@  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)-    ConstCArr :: (pred a, Integral i, Ix i) => String -> Maybe i -> [a] -> C_CMD (Param3 prog exp pred) (Arr i a)+    NewCArr   :: (pred a, pred i, Integral i, Ix i) => String -> Maybe i -> exp i -> C_CMD (Param3 prog exp pred) (Arr i a)+    ConstCArr :: (pred a, pred i, 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@@ -751,6 +772,7 @@  runPtrCMD :: PtrCMD (Param3 IO IO pred) a -> IO a runPtrCMD (SwapPtr a b) = runSwapPtr a b+runPtrCMD (SwapArr a b) = runSwapPtr a b  runHandle :: Handle -> IO.Handle runHandle (HandleRun h)         = h@@ -770,7 +792,7 @@         cs <- readWord h         return (c:cs) -runFPrintf :: [PrintfArg IO] -> (forall r . Printf.HPrintfType r => r) -> IO ()+runFPrintf :: [PrintfArg IO pred] -> (forall r . Printf.HPrintfType r => r) -> IO () runFPrintf []               pf = pf runFPrintf (PrintfArg a:as) pf = a >>= \a' -> runFPrintf as (pf a') 

@@ -14,6 +14,7 @@ import Data.IORef import Data.Typeable import System.IO.Unsafe+import Data.Constraint  import Control.Monad.Operational.Higher import System.IO.Fake@@ -100,7 +101,7 @@ --------------------------------------------------------------------------------  -- | Create an uninitialized array-newArr :: (pred a, Integral i, Ix i, ArrCMD :<: instr)+newArr :: (pred a, pred i, Integral i, Ix i, ArrCMD :<: instr)     => exp i  -- ^ Length     -> ProgramT instr (Param2 exp pred) m (Arr i a) newArr = newNamedArr "a"@@ -109,14 +110,14 @@ -- -- The provided base name may be appended with a unique identifier to avoid name -- collisions.-newNamedArr :: (pred a, Integral i, Ix i, ArrCMD :<: instr)+newNamedArr :: (pred a, pred i, Integral i, Ix i, ArrCMD :<: instr)     => String -- ^ Base name     -> exp i  -- ^ Length     -> ProgramT instr (Param2 exp pred) m (Arr i a) newNamedArr base len = singleInj (NewArr base len)  -- | Create an array and initialize it with a constant list-constArr :: (pred a, Integral i, Ix i, ArrCMD :<: instr)+constArr :: (pred a, pred i, Integral i, Ix i, ArrCMD :<: instr)     => [a]  -- ^ Initial contents     -> ProgramT instr (Param2 exp pred) m (Arr i a) constArr = constNamedArr "a"@@ -125,7 +126,7 @@ -- -- The provided base name may be appended with a unique identifier to avoid name -- collisions.-constNamedArr :: (pred a, Integral i, Ix i, ArrCMD :<: instr)+constNamedArr :: (pred a, pred i, Integral i, Ix i, ArrCMD :<: instr)     => String  -- ^ Base name     -> [a]     -- ^ Initial contents     -> ProgramT instr (Param2 exp pred) m (Arr i a)@@ -134,6 +135,7 @@ -- | Get an element of an array getArr     :: ( pred a+       , pred i        , FreeExp exp        , FreePred exp a        , Integral i@@ -145,14 +147,14 @@ getArr arr i = fmap valToExp $ singleInj $ GetArr arr i  -- | Set an element of an array-setArr :: (pred a, Integral i, Ix i, ArrCMD :<: instr) =>+setArr :: (pred a, pred i, Integral i, Ix i, ArrCMD :<: instr) =>     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 -- array.-copyArr :: (pred a, Integral i, Ix i, ArrCMD :<: instr)+copyArr :: (pred a, pred i, Integral i, Ix i, ArrCMD :<: instr)     => (Arr i a, exp i)  -- ^ (destination,offset)     -> (Arr i a, exp i)  -- ^ (source,offset     -> exp i             -- ^ Number of elements@@ -161,7 +163,7 @@  -- | Freeze a mutable array to an immutable one. This involves copying the array -- to a newly allocated one.-freezeArr :: (pred a, Integral i, Ix i, Num (exp i), ArrCMD :<: instr, Monad m)+freezeArr :: (pred a, pred i, Integral i, Ix i, Num (exp i), ArrCMD :<: instr, Monad m)     => Arr i a     -> exp i  -- ^ Length of new array     -> ProgramT instr (Param2 exp pred) m (IArr i a)@@ -173,13 +175,13 @@ -- | Freeze a mutable array to an immutable one without making a copy. This is -- generally only safe if the the mutable array is not updated as long as the -- immutable array is alive.-unsafeFreezeArr :: (pred a, Integral i, Ix i, ArrCMD :<: instr) =>+unsafeFreezeArr :: (pred a, pred i, Integral i, Ix i, ArrCMD :<: instr) =>     Arr i a -> ProgramT instr (Param2 exp pred) m (IArr i a) unsafeFreezeArr arr = singleInj $ UnsafeFreezeArr arr  -- | Thaw an immutable array to a mutable one. This involves copying the array -- to a newly allocated one.-thawArr :: (pred a, Integral i, Ix i, Num (exp i), ArrCMD :<: instr, Monad m)+thawArr :: (pred a, pred i, Integral i, Ix i, Num (exp i), ArrCMD :<: instr, Monad m)     => IArr i a     -> exp i  -- ^ Number of elements to copy     -> ProgramT instr (Param2 exp pred) m (Arr i a)@@ -192,7 +194,7 @@ -- | Thaw an immutable array to a mutable one without making a copy. This is -- generally only safe if the the mutable array is not updated as long as the -- immutable array is alive.-unsafeThawArr :: (pred a, Integral i, Ix i, ArrCMD :<: instr) =>+unsafeThawArr :: (pred a, pred i, Integral i, Ix i, ArrCMD :<: instr) =>     IArr i a -> ProgramT instr (Param2 exp pred) m (Arr i a) unsafeThawArr arr = singleInj $ UnsafeThawArr arr @@ -259,7 +261,11 @@     -> ProgramT instr (Param2 exp pred) m () assert cond msg = singleInj $ Assert cond msg -+-- | Hint that an expression may be used in an invariant+hint :: (ControlCMD :<: instr, pred a)+  => exp a -- ^ Expression to be used in invariant+  -> ProgramT instr (Param2 exp pred) m ()+hint exp = singleInj $ Hint exp  -------------------------------------------------------------------------------- -- * Pointer operations@@ -272,10 +278,13 @@ -- -- The 'IsPointer' class ensures that the operation is only possible for types -- that are represented as pointers in C.-unsafeSwap :: (IsPointer a, PtrCMD :<: instr) =>-    a -> a -> ProgramT instr (Param2 exp pred) m ()+unsafeSwap :: (PtrCMD :<: instr) =>+    Ptr a -> Ptr a -> ProgramT instr (Param2 exp pred) m () unsafeSwap a b = singleInj $ SwapPtr a b +unsafeSwapArr :: (Typeable i, Typeable a, pred i, pred a, PtrCMD :<: instr) =>+    Arr i a -> Arr i a -> ProgramT instr (Param2 exp pred) m ()+unsafeSwapArr a b = singleInj $ SwapArr a b   --------------------------------------------------------------------------------@@ -299,18 +308,21 @@ class PrintfType r   where     type PrintfExp r :: * -> *-    fprf :: Handle -> String -> [PrintfArg (PrintfExp r)] -> r+    type PrintfPred r :: * -> Constraint+    fprf :: Handle -> String -> [PrintfArg (PrintfExp r) (PrintfPred r)] -> r  instance (FileCMD :<: instr, a ~ ()) =>     PrintfType (ProgramT instr (Param2 exp pred) m a)   where     type PrintfExp (ProgramT instr (Param2 exp pred) m a) = exp+    type PrintfPred (ProgramT instr (Param2 exp pred) m a) = pred     fprf h form as = singleInj $ FPrintf h form (reverse as) -instance (Formattable a, PrintfType r, exp ~ PrintfExp r) =>+instance (Formattable a, PrintfType r, exp ~ PrintfExp r, PrintfPred r a) =>     PrintfType (exp a -> r)   where     type PrintfExp  (exp a -> r) = exp+    type PrintfPred (exp a -> r) = PrintfPred r     fprf h form as = \a -> fprf h form (PrintfArg a : as)  -- | Print to a handle. Accepts a variable number of arguments.@@ -319,7 +331,7 @@  -- | Put a single value to a handle fput :: forall instr exp pred a m-    .  (Formattable a, FreePred exp a, FileCMD :<: instr)+    .  (Formattable a, FreePred exp a, FileCMD :<: instr, pred a)     => Handle     -> String  -- ^ Prefix     -> exp a   -- ^ Expression to print