diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,8 @@ +2025-01-20 + * Version bump (4.2). (#31) + * Implement missing floating-point operations. (#28) + * Allow using same trigger name in multiple declarations. (#30) + 2024-11-08 * Version bump (4.1). (#25) diff --git a/copilot-bluespec.cabal b/copilot-bluespec.cabal --- a/copilot-bluespec.cabal +++ b/copilot-bluespec.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-bluespec -version : 4.1 +version : 4.2 synopsis : A compiler for Copilot targeting FPGAs. description : This package is a back-end from Copilot to FPGAs in Bluespec. @@ -44,7 +44,7 @@ , filepath >= 1.4 && < 1.5 , pretty >= 1.1.2 && < 1.2 - , copilot-core >= 4.1 && < 4.2 + , copilot-core >= 4.2 && < 4.3 , language-bluespec >= 0.1 && < 0.2 exposed-modules : Copilot.Compile.Bluespec @@ -54,7 +54,9 @@ , Copilot.Compile.Bluespec.Error , Copilot.Compile.Bluespec.Expr , Copilot.Compile.Bluespec.External + , Copilot.Compile.Bluespec.FloatingPoint , Copilot.Compile.Bluespec.Name + , Copilot.Compile.Bluespec.Representation , Copilot.Compile.Bluespec.Settings , Copilot.Compile.Bluespec.Type diff --git a/src/Copilot/Compile/Bluespec/CodeGen.hs b/src/Copilot/Compile/Bluespec/CodeGen.hs --- a/src/Copilot/Compile/Bluespec/CodeGen.hs +++ b/src/Copilot/Compile/Bluespec/CodeGen.hs @@ -35,6 +35,7 @@ import Copilot.Compile.Bluespec.Expr import Copilot.Compile.Bluespec.External import Copilot.Compile.Bluespec.Name +import Copilot.Compile.Bluespec.Representation import Copilot.Compile.Bluespec.Type -- | Write a generator function for a stream. @@ -151,22 +152,24 @@ mkField name $ tReg `BS.TAp` transType ty -- | Define a rule for a trigger function. -mkTriggerRule :: Trigger -> BS.CRule -mkTriggerRule (Trigger name _ args) = +mkTriggerRule :: UniqueTrigger -> BS.CRule +mkTriggerRule (UniqueTrigger uniqueName (Trigger name _ args)) = BS.CRule [] - (Just $ cLit $ BS.LString name) + (Just $ cLit $ BS.LString uniqueName) [ BS.CQFilter $ BS.CVar $ BS.mkId BS.NoPos $ - fromString $ guardName name + fromString $ guardName uniqueName ] (BS.CApply nameExpr args') where ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName + -- Note that we use 'name' here instead of 'uniqueName', as 'name' is the + -- name of the actual external function. nameId = BS.mkId BS.NoPos $ fromString $ lowercaseName name nameExpr = BS.CSelect (BS.CVar ifcArgId) nameId - args' = take (length args) (map argCall (argNames name)) + args' = take (length args) (map argCall (argNames uniqueName)) argCall = BS.CVar . BS.mkId BS.NoPos . fromString -- | Writes the @step@ rule that updates all streams. diff --git a/src/Copilot/Compile/Bluespec/Compile.hs b/src/Copilot/Compile/Bluespec/Compile.hs --- a/src/Copilot/Compile/Bluespec/Compile.hs +++ b/src/Copilot/Compile/Bluespec/Compile.hs @@ -8,9 +8,10 @@ ) where -- External imports -import Data.List (nub, union) +import Data.List (nub, nubBy, union) import Data.Maybe (catMaybes, maybeToList) import Data.String (IsString (..)) +import Data.Type.Equality (testEquality, (:~:)(Refl)) import Data.Typeable (Typeable) import qualified Language.Bluespec.Classic.AST as BS import qualified Language.Bluespec.Classic.AST.Builtin.Ids as BS @@ -27,7 +28,9 @@ -- Internal imports import Copilot.Compile.Bluespec.CodeGen import Copilot.Compile.Bluespec.External +import Copilot.Compile.Bluespec.FloatingPoint import Copilot.Compile.Bluespec.Name +import Copilot.Compile.Bluespec.Representation import Copilot.Compile.Bluespec.Settings -- | Compile a specification to a Bluespec file. @@ -38,12 +41,20 @@ -- that are generated. compileWith :: BluespecSettings -> String -> Spec -> IO () compileWith bsSettings prefix spec - | null (specTriggers spec) + | null triggers = do hPutStrLn stderr $ "Copilot error: attempt at compiling empty specification.\n" ++ "You must define at least one trigger to generate Bluespec monitors." exitFailure + | incompatibleTriggers triggers + = do hPutStrLn stderr $ + "Copilot error: attempt at compiling specification with conflicting " + ++ "trigger definitions.\n" + ++ "Multiple triggers have the same name, but different argument " + ++ "types.\n" + exitFailure + | otherwise = do let typesBsFile = render $ pPrint $ compileTypesBS bsSettings prefix spec ifcBsFile = render $ pPrint $ compileIfcBS bsSettings prefix spec @@ -53,8 +64,28 @@ createDirectoryIfMissing True dir writeFile (dir specTypesPkgName prefix ++ ".bs") typesBsFile writeFile (dir specIfcPkgName prefix ++ ".bs") ifcBsFile + writeFile (dir "bs_fp.c") copilotBluespecFloatingPointC + writeFile (dir "BluespecFP.bsv") copilotBluespecFloatingPointBSV writeFile (dir prefix ++ ".bs") bsFile + where + triggers = specTriggers spec + -- Check that two triggers do no conflict, that is: if their names are + -- equal, the types of their arguments should be equal as well. + incompatibleTriggers :: [Trigger] -> Bool + incompatibleTriggers = pairwiseAny conflict + where + conflict :: Trigger -> Trigger -> Bool + conflict t1@(Trigger name1 _ _) t2@(Trigger name2 _ _) = + name1 == name2 && not (compareTrigger t1 t2) + + -- True if the function holds for any pair of elements. We assume that + -- the function is commutative. + pairwiseAny :: (a -> a -> Bool) -> [a] -> Bool + pairwiseAny _ [] = False + pairwiseAny _ (_:[]) = False + pairwiseAny f (x:xs) = any (f x) xs || pairwiseAny f xs + -- | Compile a specification to a Bluespec. -- -- The first argument is used as a prefix for the generated .bs files. @@ -106,6 +137,7 @@ $ specTypesPkgName prefix , BS.CImpId False $ BS.mkId BS.NoPos $ fromString $ specIfcPkgName prefix + , BS.CImpId False $ BS.mkId BS.NoPos "BluespecFP" ] moduleDef :: BS.CDefn @@ -132,11 +164,12 @@ ifcModId = BS.mkId BS.NoPos "ifcMod" rules :: [BS.CRule] - rules = map mkTriggerRule triggers ++ maybeToList (mkStepRule streams) + rules = map mkTriggerRule uniqueTriggers ++ maybeToList (mkStepRule streams) - streams = specStreams spec - triggers = specTriggers spec - exts = gatherExts streams triggers + streams = specStreams spec + triggers = specTriggers spec + uniqueTriggers = mkUniqueTriggers triggers + exts = gatherExts streams triggers ifcId = BS.mkId BS.NoPos $ fromString $ specIfcName prefix ifcFields = mkSpecIfcFields triggers exts @@ -165,7 +198,7 @@ genFuns :: [BS.CDefl] genFuns = map accessDecln streams ++ map streamGen streams - ++ concatMap triggerGen triggers + ++ concatMap triggerGen uniqueTriggers where accessDecln :: Stream -> BS.CDefl accessDecln (Stream sId buff _ ty) = mkAccessDecln sId ty buff @@ -173,11 +206,12 @@ streamGen :: Stream -> BS.CDefl streamGen (Stream sId _ expr ty) = mkGenFun (generatorName sId) expr ty - triggerGen :: Trigger -> [BS.CDefl] - triggerGen (Trigger name guard args) = guardDef : argDefs + triggerGen :: UniqueTrigger -> [BS.CDefl] + triggerGen (UniqueTrigger uniqueName (Trigger _name guard args)) = + guardDef : argDefs where - guardDef = mkGenFun (guardName name) guard Bool - argDefs = map argGen (zip (argNames name) args) + guardDef = mkGenFun (guardName uniqueName) guard Bool + argDefs = map argGen (zip (argNames uniqueName) args) argGen :: (String, UExpr) -> BS.CDefl argGen (argName, UExpr ty expr) = mkGenFun argName expr ty @@ -208,9 +242,11 @@ ifcFields = mkSpecIfcFields triggers exts streams = specStreams spec - triggers = specTriggers spec exts = gatherExts streams triggers + -- Remove duplicates due to multiple guards for the same trigger. + triggers = nubBy compareTrigger (specTriggers spec) + ifcDef :: BS.CDefn ifcDef = BS.Cstruct True @@ -240,8 +276,10 @@ exprs = gatherExprs streams triggers streams = specStreams spec - triggers = specTriggers spec + -- Remove duplicates due to multiple guards for the same trigger. + triggers = nubBy compareTrigger (specTriggers spec) + -- Generate type declarations. mkTypeDeclns :: [UExpr] -> [BS.CDefn] mkTypeDeclns es = catMaybes $ map mkTypeDecln uTypes @@ -292,3 +330,21 @@ where streamUExpr (Stream _ _ expr ty) = UExpr ty expr triggerUExpr (Trigger _ guard args) = UExpr Bool guard : args + +-- | We consider triggers to be equal, if their names match and the number and +-- types of arguments. +compareTrigger :: Trigger -> Trigger -> Bool +compareTrigger (Trigger name1 _ args1) (Trigger name2 _ args2) + = name1 == name2 && compareArguments args1 args2 + + where + compareArguments :: [UExpr] -> [UExpr] -> Bool + compareArguments [] [] = True + compareArguments [] _ = False + compareArguments _ [] = False + compareArguments (x:xs) (y:ys) = compareUExpr x y && compareArguments xs ys + + compareUExpr :: UExpr -> UExpr -> Bool + compareUExpr (UExpr ty1 _) (UExpr ty2 _) + | Just Refl <- testEquality ty1 ty2 = True + | otherwise = False diff --git a/src/Copilot/Compile/Bluespec/Expr.hs b/src/Copilot/Compile/Bluespec/Expr.hs --- a/src/Copilot/Compile/Bluespec/Expr.hs +++ b/src/Copilot/Compile/Bluespec/Expr.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Translate Copilot Core expressions and operators to Bluespec. module Copilot.Compile.Bluespec.Expr @@ -81,38 +82,37 @@ (BS.CVar (BS.idSlashAt BS.NoPos)) [constNumTy ty 1, e] BwNot _ty -> app $ BS.idInvertAt BS.NoPos - Sqrt _ty -> BS.CSelect - (BS.CApply - (BS.CVar (BS.mkId BS.NoPos "sqrtFP")) - [e, fpRM]) - BS.idPrimFst Cast fromTy toTy -> transCast fromTy toTy e GetField (Struct _) _ f -> BS.CSelect e $ BS.mkId BS.NoPos $ fromString $ lowercaseName $ accessorName f GetField _ _ _ -> impossible "transOp1" "copilot-bluespec" - -- Unsupported operations (see - -- https://github.com/B-Lang-org/bsc/discussions/534) - Exp _ty -> unsupportedFPOp "exp" - Log _ty -> unsupportedFPOp "log" - Acos _ty -> unsupportedFPOp "acos" - Asin _ty -> unsupportedFPOp "asin" - Atan _ty -> unsupportedFPOp "atan" - Cos _ty -> unsupportedFPOp "cos" - Sin _ty -> unsupportedFPOp "sin" - Tan _ty -> unsupportedFPOp "tan" - Acosh _ty -> unsupportedFPOp "acosh" - Asinh _ty -> unsupportedFPOp "asinh" - Atanh _ty -> unsupportedFPOp "atanh" - Cosh _ty -> unsupportedFPOp "cosh" - Sinh _ty -> unsupportedFPOp "sinh" - Tanh _ty -> unsupportedFPOp "tanh" - Ceiling _ty -> unsupportedFPOp "ceiling" - Floor _ty -> unsupportedFPOp "floor" + -- BDPI-supported operations + Sqrt ty -> appFP ty "sqrt" + Exp ty -> appFP ty "exp" + Log ty -> appFP ty "log" + Acos ty -> appFP ty "acos" + Asin ty -> appFP ty "asin" + Atan ty -> appFP ty "atan" + Cos ty -> appFP ty "cos" + Sin ty -> appFP ty "sin" + Tan ty -> appFP ty "tan" + Acosh ty -> appFP ty "acosh" + Asinh ty -> appFP ty "asinh" + Atanh ty -> appFP ty "atanh" + Cosh ty -> appFP ty "cosh" + Sinh ty -> appFP ty "sinh" + Tanh ty -> appFP ty "tanh" + Ceiling ty -> appFP ty "ceiling" + Floor ty -> appFP ty "floor" where + app :: BS.Id -> BS.CExpr app i = BS.CApply (BS.CVar i) [e] + appFP :: forall t. Type t -> String -> BS.CExpr + appFP ty funPrefix = app $ fpFunId ty funPrefix + -- | Translates a Copilot binary operator and its arguments into a Bluespec -- function. transOp2 :: Op2 a b c -> BS.CExpr -> BS.CExpr -> BS.CExpr @@ -144,14 +144,17 @@ BS.CStructUpd e1 [(BS.mkId BS.NoPos field, e2)] UpdateField _ _ _ -> impossible "transOp2" "copilot-bluespec" - -- Unsupported operations (see - -- https://github.com/B-Lang-org/bsc/discussions/534) - Pow _ty -> unsupportedFPOp "(**)" - Logb _ty -> unsupportedFPOp "logb" - Atan2 _ty -> unsupportedFPOp "atan2" + -- BDPI-supported operations + Pow ty -> appFP ty "pow" + Logb ty -> appFP ty "logb" + Atan2 ty -> appFP ty "atan2" where + app :: BS.Id -> BS.CExpr app i = BS.CApply (BS.CVar i) [e1, e2] + appFP :: forall t. Type t -> String -> BS.CExpr + appFP ty funPrefix = app $ fpFunId ty funPrefix + -- | Translates a Copilot ternary operator and its arguments into a Bluespec -- function. transOp3 :: Op3 a b c d -> BS.CExpr -> BS.CExpr -> BS.CExpr -> BS.CExpr @@ -637,6 +640,19 @@ (BS.CVar (BS.mkId BS.NoPos "update")) [vec, idx, newElem] +-- | Create a Bluespec identifier for a floating-point function that Bluespec +-- imports using BDPI. +fpFunId :: Type a -> String -> BS.Id +fpFunId ty funPrefix = + BS.mkId BS.NoPos $ fromString $ "bs_fp_" ++ funName + where + funName :: String + funName = + case ty of + Float -> funPrefix ++ "f" + Double -> funPrefix + _ -> impossible "fpFunId" "copilot-bluespec" + -- | Explicitly annotate an expression with a type signature. This is necessary -- to prevent expressions from having ambiguous types in certain situations. withTypeAnnotation :: Type a -> BS.CExpr -> BS.CExpr @@ -647,13 +663,6 @@ typeIsFloating Float = True typeIsFloating Double = True typeIsFloating _ = False - --- | Throw an error if attempting to use a floating-point operation that --- Bluespec does not currently support. -unsupportedFPOp :: String -> a -unsupportedFPOp op = - error $ "Bluespec's FloatingPoint type does not support the " ++ op ++ - " operation." -- | We assume round-near-even throughout, but this variable can be changed if -- needed. This matches the behavior of @fpRM@ in @copilot-theorem@'s diff --git a/src/Copilot/Compile/Bluespec/FloatingPoint.hs b/src/Copilot/Compile/Bluespec/FloatingPoint.hs new file mode 100644 --- /dev/null +++ b/src/Copilot/Compile/Bluespec/FloatingPoint.hs @@ -0,0 +1,171 @@ +-- | Generate definitions that allow importing C implementations of +-- floating-point operations into Bluespec. +module Copilot.Compile.Bluespec.FloatingPoint + ( copilotBluespecFloatingPointBSV + , copilotBluespecFloatingPointC + ) where + +-- | The contents of the generated @BluespecFP.bsv@ file, which contains the +-- @import \"BDPI\"@ declarations needed to use imported C functions in +-- Bluespec. +copilotBluespecFloatingPointBSV :: String +copilotBluespecFloatingPointBSV = + unlines $ + [ "import FloatingPoint::*;" + , "" + ] ++ + concatMap + (\funName -> [importOp1 Float funName, importOp1 Double funName]) + unaryFloatOpNames ++ + concatMap + (\funName -> [importOp2 Float funName, importOp2 Double funName]) + [ "pow" + , "atan2" + , "logb" + ] + where + importOp1 :: FloatType -> String -> String + importOp1 ft funName = + "import \"BDPI\" function " ++ floatTypeName ft ++ " " ++ funNamePrefix + ++ funName ++ floatTypeSuffix ft ++ " (" ++ floatTypeName ft ++ " x);" + + importOp2 :: FloatType -> String -> String + importOp2 ft funName = + "import \"BDPI\" function " ++ floatTypeName ft ++ " " ++ funNamePrefix + ++ funName ++ floatTypeSuffix ft ++ " (" ++ floatTypeName ft ++ " x, " + ++ floatTypeName ft ++ " y);" + + floatTypeName :: FloatType -> String + floatTypeName Float = "Float" + floatTypeName Double = "Double" + +-- | The contents of the generated @bs_fp.c@ file, which contains the C wrapper +-- functions that Bluespec imports. +copilotBluespecFloatingPointC :: String +copilotBluespecFloatingPointC = + unlines $ + [ "#include " + , "" + , defineUnionType Float + , defineUnionType Double + ] ++ + concatMap + (\funName -> [defineOp1 Float funName, defineOp1 Double funName]) + unaryFloatOpNames ++ + concatMap + (\funName -> [defineOp2 Float funName, defineOp2 Double funName]) + [ "pow" + , "atan2" + ] ++ + -- There is no direct C counterpart to the `logb` function, so we implement + -- it in terms of `log`. + map + (\ft -> + defineOp2Skeleton ft "logb" $ + \_cFunName x y -> "log" ++ floatTypeSuffix ft ++ "(" ++ y ++ ") / log" + ++ floatTypeSuffix ft ++ "( " ++ x ++ ")") + [Float, Double] + where + defineUnionType :: FloatType -> String + defineUnionType ft = + unlines + [ "union " ++ unionTypeName ft ++ " {" + , " " ++ integerTypeName ft ++ " i;" + , " " ++ floatTypeName ft ++ " f;" + , "};" + ] + + defineOp1Skeleton :: + FloatType -> String -> (String -> String -> String) -> String + defineOp1Skeleton ft funName mkFloatOp = + let cFunName = funName ++ floatTypeSuffix ft in + unlines + [ integerTypeName ft ++ " " + ++ funNamePrefix ++ cFunName + ++ "(" ++ integerTypeName ft ++ " x) {" + , " union " ++ unionTypeName ft ++ " x_u;" + , " union " ++ unionTypeName ft ++ " r_u;" + , " x_u.i = x;" + , " r_u.f = " ++ mkFloatOp cFunName "x_u.f" ++ ";" + , " return r_u.i;" + , "}" + ] + + defineOp1 :: FloatType -> String -> String + defineOp1 ft funName = + defineOp1Skeleton ft funName $ + \cFunName x -> cFunName ++ "(" ++ x ++ ")" + + defineOp2Skeleton :: + FloatType -> String -> (String -> String -> String -> String) -> String + defineOp2Skeleton ft funName mkFloatOp = + let cFunName = funName ++ floatTypeSuffix ft in + unlines + [ integerTypeName ft ++ " " + ++ funNamePrefix ++ cFunName + ++ "(" ++ integerTypeName ft ++ " x, " ++ integerTypeName ft + ++ " y) {" + , " union " ++ unionTypeName ft ++ " x_u;" + , " union " ++ unionTypeName ft ++ " y_u;" + , " union " ++ unionTypeName ft ++ " r_u;" + , " x_u.i = x;" + , " y_u.i = y;" + , " r_u.f = " ++ mkFloatOp cFunName "x_u.f" "y_u.f" ++ ";" + , " return r_u.i;" + , "}" + ] + + defineOp2 :: FloatType -> String -> String + defineOp2 ft funName = + defineOp2Skeleton ft funName $ + \cFunName x y -> cFunName ++ "(" ++ x ++ ", " ++ y ++ ")" + + integerTypeName :: FloatType -> String + integerTypeName Float = "unsigned int" + integerTypeName Double = "unsigned long long" + + floatTypeName :: FloatType -> String + floatTypeName Float = "float" + floatTypeName Double = "double" + + unionTypeName :: FloatType -> String + unionTypeName Float = "ui_float" + unionTypeName Double = "ull_double" + +-- * Internals + +-- | Are we generating a function for a @float@ or @double@ operation? +data FloatType + = Float + | Double + +-- | The suffix to use in the generated function. +floatTypeSuffix :: FloatType -> String +floatTypeSuffix Float = "f" +floatTypeSuffix Double = "" + +-- | The prefix to use in the generated function. +funNamePrefix :: String +funNamePrefix = "bs_fp_" + +-- | The names of unary floating-point operations. +unaryFloatOpNames :: [String] +unaryFloatOpNames = + [ "exp" + , "log" + , "acos" + , "asin" + , "atan" + , "cos" + , "sin" + , "tan" + , "acosh" + , "asinh" + , "atanh" + , "cosh" + , "sinh" + , "tanh" + , "ceil" + , "floor" + , "sqrt" + ] diff --git a/src/Copilot/Compile/Bluespec/Representation.hs b/src/Copilot/Compile/Bluespec/Representation.hs new file mode 100644 --- /dev/null +++ b/src/Copilot/Compile/Bluespec/Representation.hs @@ -0,0 +1,22 @@ +-- | Bluespec backend specific versions of selected `Copilot.Core` datatypes. +module Copilot.Compile.Bluespec.Representation + ( UniqueTrigger (..) + , UniqueTriggerId + , mkUniqueTriggers + ) + where + +import Copilot.Core ( Trigger (..) ) + +-- | Internal unique name for a trigger. +type UniqueTriggerId = String + +-- | A `Copilot.Core.Trigger` with an unique name. +data UniqueTrigger = UniqueTrigger UniqueTriggerId Trigger + +-- | Given a list of triggers, make their names unique. +mkUniqueTriggers :: [Trigger] -> [UniqueTrigger] +mkUniqueTriggers ts = zipWith mkUnique ts [0..] + where + mkUnique :: Trigger -> Integer -> UniqueTrigger + mkUnique t@(Trigger name _ _) n = UniqueTrigger (name ++ "_" ++ show n) t diff --git a/tests/Test/Copilot/Compile/Bluespec.hs b/tests/Test/Copilot/Compile/Bluespec.hs --- a/tests/Test/Copilot/Compile/Bluespec.hs +++ b/tests/Test/Copilot/Compile/Bluespec.hs @@ -438,8 +438,22 @@ -- | Generator of functions on Floating point numbers. arbitraryOpFloat :: (Floating t, Typed t) => Gen (Fun t t, [t] -> [t]) arbitraryOpFloat = elements - [ (Op1 (Sqrt typeOf), fmap sqrt) - , (Op1 (Recip typeOf), fmap recip) + [ (Op1 (Recip typeOf), fmap recip) + , (Op1 (Exp typeOf), fmap exp) + , (Op1 (Sqrt typeOf), fmap sqrt) + , (Op1 (Log typeOf), fmap log) + , (Op1 (Sin typeOf), fmap sin) + , (Op1 (Tan typeOf), fmap tan) + , (Op1 (Cos typeOf), fmap cos) + , (Op1 (Asin typeOf), fmap asin) + , (Op1 (Atan typeOf), fmap atan) + , (Op1 (Acos typeOf), fmap acos) + , (Op1 (Sinh typeOf), fmap sinh) + , (Op1 (Tanh typeOf), fmap tanh) + , (Op1 (Cosh typeOf), fmap cosh) + , (Op1 (Asinh typeOf), fmap asinh) + , (Op1 (Atanh typeOf), fmap atanh) + , (Op1 (Acosh typeOf), fmap acosh) ] -- | Generator of functions on that produce elements of any type. @@ -1148,9 +1162,11 @@ -- | Compile a Bluespec file into an executable given its basename. compileExecutable :: String -> IO Bool compileExecutable topExe = do - result <- catch (do callProcess "bsc" $ [ "-sim", "-quiet" ] - ++ [ "-e", topExe ] - ++ [ "-o", topExe ] + result <- catch (do callProcess "bsc" [ "-sim", "-quiet" + , "-e", topExe + , "-o", topExe + , "bs_fp.c" + ] return True ) (\e -> do