packages feed

copilot-language 0.6 → 0.7

raw patch · 24 files changed

+170/−125 lines, 24 files

Files

copilot-language.cabal view
@@ -1,6 +1,6 @@ cabal-version:       >=1.10 name:                copilot-language-version:             0.6+version:             0.7 synopsis:            A Haskell-embedded DSL for monitoring hard real-time                      distributed systems. description:@@ -66,10 +66,18 @@     Copilot.Language.Stream     Copilot.Language.Spec     System.Mem.StableName.Dynamic-    System.Mem.StableName.Dynamic.Map+    System.Mem.StableName.Map    ghc-options:     -fwarn-tabs     -auto-all     -caf-all     -Wall++    -fpackage-trust+    -- Trusted packages:+    -trust base+    -trust containers+    -trust array++
src/Copilot.hs view
@@ -2,7 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- --- |+-- | Main import module for the front-end lanugage.++{-# LANGUAGE Safe #-}  module Copilot   ( module Copilot.Language
src/Copilot/Language.hs view
@@ -4,6 +4,8 @@  -- | Main Copilot language export file. +{-# LANGUAGE Safe #-}+ module Copilot.Language   ( module Data.Int   , module Data.Word
src/Copilot/Language/Analyze.hs view
@@ -2,6 +2,7 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- +{-# LANGUAGE Safe #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -23,8 +24,8 @@ import Data.IORef import Data.Typeable import System.Mem.StableName.Dynamic-import System.Mem.StableName.Dynamic.Map (Map(..))-import qualified System.Mem.StableName.Dynamic.Map as M+import System.Mem.StableName.Map (Map(..))+import qualified System.Mem.StableName.Map as M import Control.Monad (when, foldM_, foldM) import Control.Exception (Exception, throw)
src/Copilot/Language/Error.hs view
@@ -2,6 +2,8 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- +{-# LANGUAGE Safe #-}+ module Copilot.Language.Error    ( impossible   , badUsage ) where
src/Copilot/Language/Interpret.hs view
@@ -1,8 +1,9 @@ {- Copyright (c) 2011 National Institute of Aerospace / Galois, Inc. -} -{-# LANGUAGE GADTs, FlexibleInstances #-}- -- | The interpreter.++{-# LANGUAGE Safe #-}+{-# LANGUAGE GADTs, FlexibleInstances #-}  module Copilot.Language.Interpret   ( --Input
src/Copilot/Language/Operators/BitWise.hs view
@@ -2,6 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- +-- | Bitwise operators.++{-# LANGUAGE Safe #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Copilot.Language.Operators.BitWise
src/Copilot/Language/Operators/Boolean.hs view
@@ -2,7 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- --- |+-- | Boolean operators.++{-# LANGUAGE Safe #-}  module Copilot.Language.Operators.Boolean   ( (&&)
src/Copilot/Language/Operators/Cast.hs view
@@ -2,9 +2,10 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE MultiParamTypeClasses #-}- -- | Type-safe casting operators.++{-# LANGUAGE Safe #-}+{-# LANGUAGE MultiParamTypeClasses #-}  module Copilot.Language.Operators.Cast    ( cast ) where
src/Copilot/Language/Operators/Constant.hs view
@@ -4,6 +4,8 @@  -- | Constants. +{-# LANGUAGE Safe #-}+ module Copilot.Language.Operators.Constant   ( constant   , constB
src/Copilot/Language/Operators/Eq.hs view
@@ -2,7 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- --- |+-- | Equality operator.++{-# LANGUAGE Safe #-}  module Copilot.Language.Operators.Eq   ( (==)
src/Copilot/Language/Operators/Extern.hs view
@@ -2,7 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- --- |+-- | External variables, arrays, and functions.++{-# LANGUAGE Safe #-}  module Copilot.Language.Operators.Extern   ( extern
src/Copilot/Language/Operators/Integral.hs view
@@ -2,7 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- --- |+-- | Integral class operators.++{-# LANGUAGE Safe #-}  module Copilot.Language.Operators.Integral   ( div
src/Copilot/Language/Operators/Local.hs view
@@ -2,7 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- --- |+-- | Let expressions.++{-# LANGUAGE Safe #-}  module Copilot.Language.Operators.Local   ( local
src/Copilot/Language/Operators/Mux.hs view
@@ -4,6 +4,8 @@  -- | if-then-else. +{-# LANGUAGE Safe #-}+ module Copilot.Language.Operators.Mux   ( mux   , ifThenElse
src/Copilot/Language/Operators/Ord.hs view
@@ -2,7 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- --- |+-- | Comparison operators.++{-# LANGUAGE Safe #-}  module Copilot.Language.Operators.Ord   ( (<=)
src/Copilot/Language/Operators/Temporal.hs view
@@ -2,7 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- --- |+-- | Stream construction.++{-# LANGUAGE Safe #-}  module Copilot.Language.Operators.Temporal   ( (++)
src/Copilot/Language/Prelude.hs view
@@ -5,6 +5,8 @@ -- | Reexports 'Prelude' from package "base" hiding identifiers redefined by -- Copilot. +{-# LANGUAGE Safe #-}+ module Copilot.Language.Prelude   ( module Prelude   ) where
src/Copilot/Language/Reify.hs view
@@ -5,6 +5,7 @@ -- | Transforms a Copilot Language specification into a Copilot Core -- specification. +{-# LANGUAGE Safe #-} {-# LANGUAGE ExistentialQuantification, Rank2Types #-}  module Copilot.Language.Reify@@ -12,7 +13,7 @@   ) where  import qualified Copilot.Core as Core-import Copilot.Core (Typed, Type, Id, typeOf, impossible)+import Copilot.Core (Typed, Id, typeOf, impossible)  --import Copilot.Language.Reify.Sharing (makeSharingExplicit) import Copilot.Language.Analyze (analyze)@@ -22,8 +23,8 @@ import Prelude hiding (id) import Data.IORef import System.Mem.StableName.Dynamic-import System.Mem.StableName.Dynamic.Map (Map)-import qualified System.Mem.StableName.Dynamic.Map as M+import System.Mem.StableName.Map (Map)+import qualified System.Mem.StableName.Map as M import Control.Monad (liftM)  --------------------------------------------------------------------------------@@ -230,7 +231,6 @@         Core.Stream           { Core.streamId         = id           , Core.streamBuffer     = buf-          , Core.streamGuard      = Core.Const (typeOf :: Type Bool) True           , Core.streamExpr       = w           , Core.streamExprType   = typeOf }       return id
src/Copilot/Language/Spec.hs view
@@ -2,11 +2,11 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- +-- | Copilot specifications.++{-# LANGUAGE Safe #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-}---- |  module Copilot.Language.Spec   ( Spec
src/Copilot/Language/Stream.hs view
@@ -4,6 +4,7 @@  -- | Abstract syntax for streams and operators. +{-# LANGUAGE Safe #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE Rank2Types #-}
src/System/Mem/StableName/Dynamic.hs view
@@ -2,6 +2,8 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- +{-# LANGUAGE Trustworthy #-}+ module System.Mem.StableName.Dynamic   ( DynStableName(..)   , hashDynStableName@@ -9,7 +11,7 @@   ) where  import System.Mem.StableName (StableName, makeStableName, hashStableName)-import Unsafe.Coerce (unsafeCoerce)+import Unsafe.Coerce (unsafeCoerce) -- XXX Not safe!  newtype DynStableName = DynStableName (StableName ())
− src/System/Mem/StableName/Dynamic/Map.hs 
@@ -1,101 +0,0 @@------------------------------------------------------------------------------------ Most of this code is taken from 'http://github.com/ekmett/stable-maps'.-----------------------------------------------------------------------------------module System.Mem.StableName.Dynamic.Map-    ( Map(..)-    , empty-    , null-    , singleton-    , member-    , notMember-    , insert-    , insertWith-    , insertWith'-    , lookup-    , find-    , findWithDefault-    ) where--import qualified Prelude-import Prelude hiding (lookup, null)-import System.Mem.StableName.Dynamic-import qualified Data.IntMap as IntMap-import Data.IntMap (IntMap)--import Copilot.Core.Error (impossible)--data Map a = Map { getMap  :: IntMap [(DynStableName, a)] -                 , getSize :: Int } --empty :: Map a-empty = Map IntMap.empty 0--null :: Map a -> Bool-null (Map m _) = IntMap.null m--singleton :: DynStableName -> a -> Map a-singleton k v = -  Map (IntMap.singleton (hashDynStableName k) [(k,v)]) 1--member :: DynStableName -> Map a -> Bool-member k m = case lookup k m of-    Nothing -> False-    Just _ -> True--notMember :: DynStableName -> Map a -> Bool-notMember k m = not $ member k m --insert :: DynStableName -> a -> Map a -> Map a-insert k v Map { getMap  = mp-               , getSize = sz }-  = Map (IntMap.insertWith (++) (hashDynStableName k) [(k,v)] mp)-        (sz + 1)---- | /O(log n)/. Insert with a function for combining the new value and old value.--- @'insertWith' f key value mp@--- will insert the pair (key, value) into @mp@ if the key does not exist--- in the map. If the key does exist, the function will insert the pair--- @(key, f new_value old_value)@-insertWith :: (a -> a -> a) -> DynStableName -> a -> Map a -> Map a-insertWith f k v Map { getMap  = mp-                     , getSize = sz } -  = Map (IntMap.insertWith go (hashDynStableName k) [(k,v)] mp)-        (sz + 1)-    where -        go _ ((k',v'):kvs) -            | k == k' = (k', f v v') : kvs-            | otherwise = (k',v') : go undefined kvs-        go _ [] = []---- | Same as 'insertWith', but with the combining function applied strictly.-insertWith' :: (a -> a -> a) -> DynStableName -> a -> Map a -> Map a-insertWith' f k v Map { getMap  = mp-                      , getSize = sz } -  = Map (IntMap.insertWith go (hashDynStableName k) [(k,v)] mp)-        (sz + 1)-    where -        go _ ((k',v'):kvs) -            | k == k' = let v'' = f v v' in v'' `seq` (k', v'') : kvs-            | otherwise = (k', v') : go undefined kvs-        go _ [] = []---- | /O(log n)/. Lookup the value at a key in the map.--- --- The function will return the corresponding value as a @('Just' value)@--- or 'Nothing' if the key isn't in the map.-lookup :: DynStableName -> Map v -> Maybe v-lookup k (Map m _) = do-    pairs <- IntMap.lookup (hashDynStableName k) m-    Prelude.lookup k pairs--find :: DynStableName -> Map v -> v-find k m = case lookup k m of-    Nothing -> impossible "find" "copilot-language"-    Just x -> x ---- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns--- the value at key @k@ or returns the default value @def@--- when the key is not in the map.-findWithDefault :: v -> DynStableName -> Map v -> v-findWithDefault dflt k m = maybe dflt id $ lookup k m
+ src/System/Mem/StableName/Map.hs view
@@ -0,0 +1,103 @@+--------------------------------------------------------------------------------+-- Most of this code is taken from 'http://github.com/ekmett/stable-maps'.+--------------------------------------------------------------------------------++{-# LANGUAGE Safe #-}++module System.Mem.StableName.Map+    ( Map(..)+    , empty+    , null+    , singleton+    , member+    , notMember+    , insert+    , insertWith+    , insertWith'+    , lookup+    , find+    , findWithDefault+    ) where++import qualified Prelude+import Prelude hiding (lookup, null)+import System.Mem.StableName.Dynamic+import qualified Data.IntMap as IntMap+import Data.IntMap (IntMap)++import Copilot.Core.Error (impossible)++data Map a = Map { getMap  :: IntMap [(DynStableName, a)] +                 , getSize :: Int } ++empty :: Map a+empty = Map IntMap.empty 0++null :: Map a -> Bool+null (Map m _) = IntMap.null m++singleton :: DynStableName -> a -> Map a+singleton k v = +  Map (IntMap.singleton (hashDynStableName k) [(k,v)]) 1++member :: DynStableName -> Map a -> Bool+member k m = case lookup k m of+    Nothing -> False+    Just _ -> True++notMember :: DynStableName -> Map a -> Bool+notMember k m = not $ member k m ++insert :: DynStableName -> a -> Map a -> Map a+insert k v Map { getMap  = mp+               , getSize = sz }+  = Map (IntMap.insertWith (++) (hashDynStableName k) [(k,v)] mp)+        (sz + 1)++-- | /O(log n)/. Insert with a function for combining the new value and old value.+-- @'insertWith' f key value mp@+-- will insert the pair (key, value) into @mp@ if the key does not exist+-- in the map. If the key does exist, the function will insert the pair+-- @(key, f new_value old_value)@+insertWith :: (a -> a -> a) -> DynStableName -> a -> Map a -> Map a+insertWith f k v Map { getMap  = mp+                     , getSize = sz } +  = Map (IntMap.insertWith go (hashDynStableName k) [(k,v)] mp)+        (sz + 1)+    where +        go _ ((k',v'):kvs) +            | k == k' = (k', f v v') : kvs+            | otherwise = (k',v') : go undefined kvs+        go _ [] = []++-- | Same as 'insertWith', but with the combining function applied strictly.+insertWith' :: (a -> a -> a) -> DynStableName -> a -> Map a -> Map a+insertWith' f k v Map { getMap  = mp+                      , getSize = sz } +  = Map (IntMap.insertWith go (hashDynStableName k) [(k,v)] mp)+        (sz + 1)+    where +        go _ ((k',v'):kvs) +            | k == k' = let v'' = f v v' in v'' `seq` (k', v'') : kvs+            | otherwise = (k', v') : go undefined kvs+        go _ [] = []++-- | /O(log n)/. Lookup the value at a key in the map.+-- +-- The function will return the corresponding value as a @('Just' value)@+-- or 'Nothing' if the key isn't in the map.+lookup :: DynStableName -> Map v -> Maybe v+lookup k (Map m _) = do+    pairs <- IntMap.lookup (hashDynStableName k) m+    Prelude.lookup k pairs++find :: DynStableName -> Map v -> v+find k m = case lookup k m of+    Nothing -> impossible "find" "copilot-language"+    Just x -> x ++-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns+-- the value at key @k@ or returns the default value @def@+-- when the key is not in the map.+findWithDefault :: v -> DynStableName -> Map v -> v+findWithDefault dflt k m = maybe dflt id $ lookup k m