diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,12 @@ +2022-01-07 + * Version bump (3.7). (#287) + * Make imports explicit, reorganize imports. (#277) + * Remove Copilot.Core.Type.Read. (#286) + * Remove Copilot.Core.Type.Eq. (#285) + * Remove Copilot.Core.Locals. (#284) + * Deprecate Copilot.Core.Type.Show.ShowWit. (#283) + * Remove Copilot.Core.Type.Show.showWit. (#282) + 2021-11-07 * Version bump (3.6). (#264) * Deprecate Copilot.Core.Type.Dynamic.toDynF and fromDynF. (#269) diff --git a/copilot-core.cabal b/copilot-core.cabal --- a/copilot-core.cabal +++ b/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.6 +version: 3.7 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. @@ -57,14 +57,11 @@ Copilot.Core.Interpret.Render Copilot.Core.Operators Copilot.Core.Spec - Copilot.Core.Locals Copilot.Core.Type Copilot.Core.Type.Array Copilot.Core.Type.Dynamic Copilot.Core.Type.Equality - Copilot.Core.Type.Eq Copilot.Core.Type.Show - Copilot.Core.Type.Read Copilot.Core.Type.Uninitialized Copilot.Core.PrettyPrint Copilot.Core.PrettyDot diff --git a/src/Copilot/Core/Interpret/Eval.hs b/src/Copilot/Core/Interpret/Eval.hs --- a/src/Copilot/Core/Interpret/Eval.hs +++ b/src/Copilot/Core/Interpret/Eval.hs @@ -14,20 +14,23 @@ , eval ) where -import Copilot.Core hiding (badUsage) +import Copilot.Core (Expr (..), Field (..), Id, Name, + Observer (..), Op1 (..), Op2 (..), Op3 (..), + Spec, Stream (..), Trigger (..), + Type (Struct), UExpr (..), arrayelems, + specObservers, specStreams, specTriggers) import Copilot.Core.ErrorInternal (badUsage) -import Copilot.Core.Type.Show (showWithType, ShowType) +import Copilot.Core.Type.Show (ShowType, showWithType) -import Prelude hiding (id) +import Prelude hiding (id) import qualified Prelude as P -import Data.List (transpose) -import Data.Maybe (fromJust) -import Data.Bits import Control.Exception (Exception, throw) - -import Data.Dynamic (Dynamic, fromDynamic, toDyn) -import Data.Typeable (Typeable) +import Data.Bits (complement, shiftL, shiftR, xor, (.&.), (.|.)) +import Data.Dynamic (Dynamic, fromDynamic, toDyn) +import Data.List (transpose) +import Data.Maybe (fromJust) +import Data.Typeable (Typeable) -------------------------------------------------------------------------------- diff --git a/src/Copilot/Core/Locals.hs b/src/Copilot/Core/Locals.hs deleted file mode 100644 --- a/src/Copilot/Core/Locals.hs +++ /dev/null @@ -1,99 +0,0 @@ --------------------------------------------------------------------------------- --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- - --- | Let expressions. --- --- Although Copilot is a DSL embedded in Haskell and Haskell does support let --- expressions, we want Copilot to be able to implement explicit sharing, to --- detect when the same stream is being used in multiple places in a --- specification and avoid recomputing it unnecessarily. - -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE ExistentialQuantification #-} - -module Copilot.Core.Locals - {-# DEPRECATED "This module is deprecated." #-} - ( Loc (..) - , locals - ) where - -import Copilot.Core hiding (toList) -import Data.DList (DList, empty, singleton, append, concat, toList) -import Data.List (nubBy) -import Prelude hiding (concat, foldr) - --------------------------------------------------------------------------------- - --- | A local definition, with a given stream name and stream type. -data Loc = forall a . Loc - { localName :: Name - , localType :: Type a } - --- | Show the underlying stream name. -instance Show Loc where - show Loc { localName = name } = name - --------------------------------------------------------------------------------- - --- | Obtain all the local definitions in a specification. -locals :: Spec -> [Loc] -locals - Spec - { specStreams = streams - , specTriggers = triggers - , specObservers = observers - } = nubBy eqLoc . toList $ - concat (fmap locsStream streams) `append` - concat (fmap locsTrigger triggers) `append` - concat (fmap locsObserver observers) - - where - - eqLoc :: Loc -> Loc -> Bool - eqLoc Loc { localName = name1 } Loc { localName = name2 } = - name1 == name2 - --------------------------------------------------------------------------------- - --- | Obtain all the local definitions in a stream. -locsStream :: Stream -> DList Loc -locsStream Stream { streamExpr = e } = locsExpr e - --------------------------------------------------------------------------------- - --- | Obtain all the local definitions in a trigger. -locsTrigger :: Trigger -> DList Loc -locsTrigger Trigger { triggerGuard = e, triggerArgs = args } = - locsExpr e `append` concat (fmap locsUExpr args) - - where - - locsUExpr :: UExpr -> DList Loc - locsUExpr (UExpr _ e1) = locsExpr e1 - --------------------------------------------------------------------------------- - --- | Obtain all the local definitions in an observer. -locsObserver :: Observer -> DList Loc -locsObserver Observer { observerExpr = e } = locsExpr e - --------------------------------------------------------------------------------- - --- | Obtain all the local definitions in an expression. -locsExpr :: Expr a -> DList Loc -locsExpr e0 = case e0 of - Const _ _ -> empty - Drop _ _ _ -> empty - Local t _ name e1 e2 -> singleton (Loc name t) - `append` locsExpr e1 - `append` locsExpr e2 - Var _ _ -> empty - ExternVar _ _ _ -> empty - Op1 _ e -> locsExpr e - Op2 _ e1 e2 -> locsExpr e1 `append` locsExpr e2 - Op3 _ e1 e2 e3 -> locsExpr e1 `append` locsExpr e2 - `append` locsExpr e3 - Label _ _ e -> locsExpr e - --------------------------------------------------------------------------------- diff --git a/src/Copilot/Core/Type/Eq.hs b/src/Copilot/Core/Type/Eq.hs deleted file mode 100644 --- a/src/Copilot/Core/Type/Eq.hs +++ /dev/null @@ -1,79 +0,0 @@ --------------------------------------------------------------------------------- --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- - -{-# LANGUAGE Safe #-} -{-# LANGUAGE ExistentialQuantification, GADTs #-} - -module Copilot.Core.Type.Eq - {-# DEPRECATED "This module is deprecated." #-} - ( EqWit (..) - , eqWit - , UVal (..) - ) where - -import Copilot.Core.ErrorInternal (impossible) -import Copilot.Core.Type -import Copilot.Core.Type.Dynamic (fromDyn, toDyn) - --------------------------------------------------------------------------------- - -data EqWit a = Eq a => EqWit - --------------------------------------------------------------------------------- - -eqWit :: Type a -> EqWit a -eqWit t = - case t of - Bool -> EqWit - Int8 -> EqWit - Int16 -> EqWit - Int32 -> EqWit - Int64 -> EqWit - Word8 -> EqWit - Word16 -> EqWit - Word32 -> EqWit - Word64 -> EqWit - Float -> EqWit - Double -> EqWit - --------------------------------------------------------------------------------- - -data UVal = forall a. UVal - { uType :: Type a - , uVal :: a - } - --------------------------------------------------------------------------------- - -instance Eq UVal where - (==) UVal { uType = t1 - , uVal = a } - UVal { uType = t2 - , uVal = b } - = case eqWit t1 of - EqWit -> - case eqWit t2 of - EqWit -> - let dyn1 = toDyn t1 a in - case fromDyn t2 dyn1 of - Nothing -> False - Just x -> - case t1 of - -- Hacks for QuickChecking between C and Haskell - Float -> case t2 of - Float -> approx floatErr x b - _ -> impossible "instance Eq UVal" - "copilot-core" - Double -> case t2 of - Double -> approx doubleErr x b - _ -> impossible "instance Eq UVal" - "copilot-core" - _ -> x == b - where - approx :: (Num a, Ord a) => a -> a -> a -> Bool - approx err x y = x - y < err && y - x < err - floatErr = 0.0001 :: Float - doubleErr = 0.0001 :: Double - --------------------------------------------------------------------------------- diff --git a/src/Copilot/Core/Type/Read.hs b/src/Copilot/Core/Type/Read.hs deleted file mode 100644 --- a/src/Copilot/Core/Type/Read.hs +++ /dev/null @@ -1,53 +0,0 @@ --------------------------------------------------------------------------------- --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- - -{-# LANGUAGE Safe #-} -{-# LANGUAGE ExistentialQuantification, GADTs #-} - -module Copilot.Core.Type.Read - {-# DEPRECATED "This module is deprecated." #-} - ( ReadWit (..) - , readWit - , readWithType - ) where - -import Copilot.Core.Type -import Copilot.Core.ErrorInternal (badUsage) - --------------------------------------------------------------------------------- - -data ReadWit a = Read a => ReadWit - --------------------------------------------------------------------------------- - -readWit :: Type a -> ReadWit a -readWit t = - case t of - Bool -> ReadWit - Int8 -> ReadWit - Int16 -> ReadWit - Int32 -> ReadWit - Int64 -> ReadWit - Word8 -> ReadWit - Word16 -> ReadWit - Word32 -> ReadWit - Word64 -> ReadWit - Float -> ReadWit - Double -> ReadWit - --------------------------------------------------------------------------------- - -readWithType :: Type a -> String -> a -readWithType t str = - case t of - Bool -> case str of - "0" -> False - "1" -> True - x -> badUsage $ "in readWithType in copilot-core: expecting a \"0\" or \"1\" when reading a Boolean value " ++ show x ++ "." - _ -> rd - where - rd = case readWit t of - ReadWit -> read str - --------------------------------------------------------------------------------- diff --git a/src/Copilot/Core/Type/Show.hs b/src/Copilot/Core/Type/Show.hs --- a/src/Copilot/Core/Type/Show.hs +++ b/src/Copilot/Core/Type/Show.hs @@ -8,7 +8,6 @@ -- | Show Copilot Core types and typed values. module Copilot.Core.Type.Show ( ShowWit (..) - , showWit , showWithType , ShowType(..) , showType @@ -19,12 +18,12 @@ -------------------------------------------------------------------------------- -- | Witness datatype for showing a value, used by 'showWithType'. +{-# DEPRECATED ShowWit "This type is deprecated in Copilot 3.7." #-} data ShowWit a = Show a => ShowWit -------------------------------------------------------------------------------- -- | Turn a type into a show witness. -{-# DEPRECATED showWit "This function is deprecated in Copilot 3.4." #-} showWit :: Type a -> ShowWit a showWit t = case t of