diff --git a/CHANGELOG b/CHANGELOG index 0fdc0d1..f241555 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,6 @@ +2025-03-20 + * Move Copilot.Compile.Bluespec.External out of shared directory. (#36) + 2025-03-10 * Version bump (4.3). (#34) diff --git a/copilot-bluespec.cabal b/copilot-bluespec.cabal index 32ce9b5..cab6f71 100644 --- a/copilot-bluespec.cabal +++ b/copilot-bluespec.cabal @@ -36,7 +36,7 @@ source-repository head library default-language : Haskell2010 - hs-source-dirs : src, shared + hs-source-dirs : src ghc-options : -Wall build-depends : base >= 4.9 && < 5 @@ -70,7 +70,7 @@ test-suite tests other-modules: Test.Copilot.Compile.Bluespec - Copilot.Compile.Bluespec.External + Test.Copilot.Compile.Bluespec.External build-depends: base @@ -91,7 +91,7 @@ test-suite tests , copilot-bluespec hs-source-dirs: - tests, shared + tests default-language: Haskell2010 diff --git a/shared/Copilot/Compile/Bluespec/External.hs b/src/Copilot/Compile/Bluespec/External.hs similarity index 96% rename from shared/Copilot/Compile/Bluespec/External.hs rename to src/Copilot/Compile/Bluespec/External.hs index 12bc404..6d42105 100644 --- a/shared/Copilot/Compile/Bluespec/External.hs +++ b/src/Copilot/Compile/Bluespec/External.hs @@ -22,7 +22,7 @@ data External = forall a. External -- | Collect all external variables from the streams and triggers. -- -- Although Copilot specifications can contain also properties and theorems, --- the C99 backend currently only generates code for streams and triggers. +-- the Bluespec backend currently only generates code for streams and triggers. gatherExts :: [Stream] -> [Trigger] -> [External] gatherExts streams triggers = streamsExts `extUnion` triggersExts where diff --git a/tests/Test/Copilot/Compile/Bluespec.hs b/tests/Test/Copilot/Compile/Bluespec.hs index d54051d..ee99c6e 100644 --- a/tests/Test/Copilot/Compile/Bluespec.hs +++ b/tests/Test/Copilot/Compile/Bluespec.hs @@ -47,11 +47,12 @@ import Text.ParserCombinators.ReadPrec (minPrec) -- External imports: Copilot import Copilot.Core hiding (Property) --- External imports: Modules being tested -import Copilot.Compile.Bluespec (bluespecSettingsOutputDirectory, - compile, compileWith, - mkDefaultBluespecSettings) -import Copilot.Compile.Bluespec.External (External (extName), gatherExts) +-- External imports +import Copilot.Compile.Bluespec (bluespecSettingsOutputDirectory, compile, + compileWith, mkDefaultBluespecSettings) + +-- Internal imports +import Test.Copilot.Compile.Bluespec.External (External (extName), gatherExts) -- * Constants diff --git a/tests/Test/Copilot/Compile/Bluespec/External.hs b/tests/Test/Copilot/Compile/Bluespec/External.hs new file mode 100644 index 0000000..01b1038 --- /dev/null +++ b/tests/Test/Copilot/Compile/Bluespec/External.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE ExistentialQuantification #-} + +-- | This is a duplicate version of @Copilot.Compile.Bluespec.External@ that is +-- specific to the test suite. Ideally, we would move this into a common library +-- that is shared between both @copilot-bluespec@ and @copilot-c99@ so that we +-- can avoid this duplication. See +-- https://github.com/Copilot-Language/copilot-bluespec/issues/3. +-- +-- Represent information about externs needed in the generation of Bluespec +-- code for stream declarations and triggers. +module Test.Copilot.Compile.Bluespec.External + ( External(..) + , gatherExts + ) where + +-- External imports +import Data.List (unionBy) + +-- External imports: Copilot +import Copilot.Core ( Expr (..), Stream (..), Trigger (..), Type, UExpr (..) ) + +-- | Representation of external variables. +data External = forall a. External + { extName :: String + , extType :: Type a + } + +-- | Collect all external variables from the streams and triggers. +-- +-- Although Copilot specifications can contain also properties and theorems, +-- the Bluespec backend currently only generates code for streams and triggers. +gatherExts :: [Stream] -> [Trigger] -> [External] +gatherExts streams triggers = streamsExts `extUnion` triggersExts + where + streamsExts = foldr (extUnion . streamExts) mempty streams + triggersExts = foldr (extUnion . triggerExts) mempty triggers + + streamExts :: Stream -> [External] + streamExts (Stream _ _ expr _) = exprExts expr + + triggerExts :: Trigger -> [External] + triggerExts (Trigger _ guard args) = guardExts `extUnion` argExts + where + guardExts = exprExts guard + argExts = concatMap uExprExts args + + uExprExts :: UExpr -> [External] + uExprExts (UExpr _ expr) = exprExts expr + + exprExts :: Expr a -> [External] + exprExts (Local _ _ _ e1 e2) = exprExts e1 `extUnion` exprExts e2 + exprExts (ExternVar ty name _) = [External name ty] + exprExts (Op1 _ e) = exprExts e + exprExts (Op2 _ e1 e2) = exprExts e1 `extUnion` exprExts e2 + exprExts (Op3 _ e1 e2 e3) = exprExts e1 `extUnion` exprExts e2 + `extUnion` exprExts e3 + exprExts (Label _ _ e) = exprExts e + exprExts _ = [] + + -- | Union over lists of External, we solely base the equality on the + -- extName's. + extUnion :: [External] -> [External] -> [External] + extUnion = unionBy (\a b -> extName a == extName b)