Rattus 0.3 → 0.3.1

raw patch · 8 files changed

+48/−24 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• Rattus.cabal +1/−1
• src/Rattus/Event.hs +1/−1
• src/Rattus/Plugin/Strictify.hs +4/−1
• src/Rattus/Plugin/Utils.hs +5/−10
• src/Rattus/Stream.hs +11/−7
• test/TimeLeak.hs +7/−4
• test/WellTyped.hs +12/−0

@@ -1,3 +1,10 @@+0.3.1+-----++Guarded recursive types Str and Event are now fully strict (i.e. in+particular, they are strict in the component that is of a later type)+as they should be.+ 0.3 --- 

@@ -1,6 +1,6 @@ cabal-version:       1.18 name:                Rattus-version:             0.3+version:             0.3.1 category:            FRP synopsis:            A modal FRP language description:

@@ -25,7 +25,7 @@   -- | An event may either occur now or later.-data Event a = Now !a | Wait (O (Event a))+data Event a = Now !a | Wait !(O (Event a))  -- all functions in this module are in Rattus  {-# ANN module Rattus #-}

@@ -8,7 +8,10 @@  data SCxt = SCxt {srcSpan :: SrcSpan, checkStrictData :: Bool} -+-- | Transforms all functions into strict functions. If the+-- 'checkStrictData' field of the 'SCxt' argument is set to @True@,+-- then this function also checks for use of non-strict data types and+-- produces warnings if it finds any. strictifyExpr :: SCxt -> CoreExpr -> CoreM CoreExpr strictifyExpr ss (Let (NonRec b e1) e2) = do   e1' <- strictifyExpr ss e1

@@ -184,7 +184,7 @@             case algTyConRhs con of               DataTyCon {data_cons = cons, is_enum = enum}                 | enum -> True-                | and $ (map (isSrcStrictOrDelay args)) $ cons ->+                | and $ (map (areSrcStrict args)) $ cons ->                   and  (map check cons)                 | otherwise -> False                 where check con = case dataConInstSig con args of@@ -197,17 +197,12 @@   -isSrcStrictOrDelay :: [Type] -> DataCon -> Bool-isSrcStrictOrDelay args con = and (zipWith check tys (dataConSrcBangs con))+areSrcStrict :: [Type] -> DataCon -> Bool+areSrcStrict args con = and (zipWith check tys (dataConSrcBangs con))   where (_, _,tys) = dataConInstSig con args -        check ty b = isSrcStrict' b || isDelay ty-        isDelay ty = case splitTyConApp_maybe ty of-                       Just (con,_) ->-                         case getNameModule con of-                           Just (name,mod) | isRattModule mod && name == "O" -> True-                           _ -> False-                       _ -> False+        check _ b = isSrcStrict' b +isSrcStrict' :: HsSrcBang -> Bool isSrcStrict' (HsSrcBang _ _ SrcStrict) = True isSrcStrict' _ = False 

@@ -30,7 +30,7 @@ import Data.VectorSpace  -- | @Str a@ is a stream of values of type @a@.-data Str a = ! a ::: (O (Str a))+data Str a = ! a ::: !(O (Str a))  -- all functions in this module are in Rattus  {-# ANN module Rattus #-}@@ -47,18 +47,15 @@  -- | Apply a function to each element of a stream. map :: Box (a -> b) -> Str a -> Str b-{-# NOINLINE [1] map #-} map f (x ::: xs) = unbox f x ::: delay (map f (adv xs))   -- | Construct a stream that has the same given value at each step.-{-# NOINLINE [1] const #-} const :: Stable a => a -> Str a const a = a ::: delay (const a)  -- | Variant of 'const' that allows any type @a@ as argument as long -- as it is boxed.-{-# NOINLINE [1] constBox #-} constBox :: Box a -> Str a constBox a = unbox a ::: delay (constBox a) @@ -73,7 +70,6 @@ -- > scan (box f) x (v1 ::: v2 ::: v3 ::: ... ) == (x `f` v1) ::: ((x `f` v1) `f` v2) ::: ... -- -- Note: Unlike 'scanl', 'scan' starts with @x `f` v1@, not @x@.-{-# NOINLINE [1] scan #-} scan :: (Stable b) => Box(b -> a -> b) -> b -> Str a -> Str b scan f acc (a ::: as) =  acc' ::: delay (scan f acc' (adv as))   where acc' = unbox f acc a@@ -81,7 +77,6 @@ -- | 'scanMap' is a composition of 'map' and 'scan': -- -- > scanMap f g x === map g . scan f x-{-# NOINLINE [1] scanMap #-} scanMap :: (Stable b) => Box(b -> a -> b) -> Box (b -> c) -> b -> Str a -> Str c scanMap f p acc (a ::: as) =  unbox p acc' ::: delay (scanMap f p acc' (adv as))   where acc' = unbox f acc a@@ -98,7 +93,6 @@ zipWith f (a ::: as) (b ::: bs) = unbox f a b ::: delay (zipWith f (adv as) (adv bs))  -- | Similar to 'Prelude.zip' on Haskell lists.-{-# NOINLINE [1] zip #-} zip :: Str a -> Str b -> Str (a:*b) zip (a ::: as) (b ::: bs) =  (a :* b) ::: delay (zip (adv as) (adv bs)) @@ -135,6 +129,16 @@ integral acc (t ::: ts) (a ::: as) = acc' ::: delay (integral acc' (adv ts) (adv as))   where acc' = acc ^+^ (t *^ a) ++-- Prevent functions from being inlined too early for the rewrite+-- rules to fire.++{-# NOINLINE [1] map #-}+{-# NOINLINE [1] const #-}+{-# NOINLINE [1] constBox #-}+{-# NOINLINE [1] scan #-}+{-# NOINLINE [1] scanMap #-}+{-# NOINLINE [1] zip #-}   {-# RULES

@@ -10,10 +10,12 @@  {-# ANN module Rattus #-} ++-- | This function should be fine (no warnings, no time-leaks) nats' :: Str Int nats' = unfold (box ((+) 1)) 0 -+-- | This function should be fine (no warnings, no time-leaks) nats :: Str Int nats = from  0     where from :: Int -> Str Int@@ -41,7 +43,7 @@ leakyAlt = 0 ::: delay (altMap (box ((+)1)) (box ((+)2)) leakyAlt)  -+-- This function should cause a warning. mapMap :: Box (a -> a) -> Box (a -> a) -> Str a -> Str a mapMap f g (x ::: xs) = unbox f x ::: delay (map g (mapMap g f (adv xs))) @@ -64,10 +66,11 @@   where run :: Box (() -> Int) -> Int -> Str Int -> Str Int         run f a (x ::: xs) = (if a == 0 then unbox f () else a) ::: delay (run (box (\ () -> (unbox f () + x))) a (adv xs)) -+-- This function should cause a warning. natsTrans :: Str Int -> Str Int natsTrans (x ::: xs) = x ::: delay (map (box ((+)x)) $ natsTrans $ adv xs)- ++-- This function should cause a warning. leakySum :: Box (Int -> Int) -> Str Int -> Str Int leakySum f (x ::: xs) = unbox f x ::: (delay (leakySum (box (\ y -> unbox f (y + x)))) <*> xs) 

@@ -62,6 +62,18 @@ map3 f = run   where run (x ::: xs) = unbox f x ::: (delay run <*> xs) ++-- local mutual recursive definition+nestedMutual :: Str Int -> Str Int+nestedMutual = lbar1 (box (+1))+  where lbar1 :: Box (a -> b) -> Str a -> Str b+        lbar1 f (x ::: xs) = unbox f x ::: (delay (lbar2 f) <*> xs)++        lbar2 :: Box (a -> b) -> Str a -> Str b+        lbar2 f  (x ::: xs) = unbox f x ::: (delay (lbar1 f) <*> xs)+++ -- mutual recursive definition bar1 :: Box (a -> b) -> Str a -> Str b bar1 f (x ::: xs) = unbox f x ::: (delay (bar2 f) <*> xs)