Merge pull request #38 from Copilot-Language/T36-move-shared-to-src

Move `Copilot.Compile.Bluespec.External` out of `shared` directory. Refs #36.

Author: RyanGlScott

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)
 

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

…red/Copilot/Compile/Bluespec/External.hs src/Copilot/Compile/Bluespec/External.hsshared/Copilot/Compile/Bluespec/External.hs renamed to src/Copilot/Compile/Bluespec/External.hs shared/Copilot/Compile/Bluespec/External.hs renamed to 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

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
 

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)