clash-ghc 0.5.5 → 0.5.6
raw patch · 6 files changed
+136/−37 lines, 6 filesdep ~clash-libdep ~clash-preludedep ~clash-systemverilog
Dependency ranges changed: clash-lib, clash-prelude, clash-systemverilog, clash-vhdl, ghc-typelits-natnormalise
Files
- CHANGELOG.md +9/−0
- clash-ghc.cabal +7/−7
- src-bin/InteractiveUI.hs +17/−14
- src-bin/Main.hs +26/−15
- src-ghc/CLaSH/GHC/CLaSHFlags.hs +52/−0
- src-ghc/CLaSH/GHC/Evaluator.hs +25/−1
CHANGELOG.md view
@@ -1,5 +1,14 @@ # Changelog for the [`clash-ghc`](http://hackage.haskell.org/package/clash-ghc) package +## 0.5.6 *May 18th 2015*+* New features:+ * Inlining limit is configurable, run with `-clash-inline-limit=N` to set the inlining limit to `N`+ * Specialisation limit is configurable, run with `clash-spec-limit=N` to set the inline limit to `N`+ * Debug level is configurable, run with `-clash-debug <LEVEL>` where `<LEVEL>` can be: `DebugNone, DebugFinal, DebugName, DebugApplied, DebugAll`. Be default, `clash` runs with `DebugNone`.++* Fixes bugs:+ * Extend evaluator for `GHC.Integer.Type.minusInteger` and `CLaSH.Promoted.Nat.SNat`.+ ## 0.5.5 *May 5th 2015* * New features: * `TopEntity` wrappers are now specified as `ANN` annotation pragmas [#42](https://github.com/clash-lang/clash-compiler/issues/42)
clash-ghc.cabal view
@@ -1,5 +1,5 @@ Name: clash-ghc-Version: 0.5.5+Version: 0.5.6 Synopsis: CAES Language for Synchronous Hardware Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -70,12 +70,11 @@ unbound-generics >= 0.1, unordered-containers >= 0.2.1.0, - clash-lib >= 0.5.3,- clash-prelude >= 0.7.4,- clash-vhdl >= 0.5.3,- clash-systemverilog >= 0.5.2,- clash-prelude >= 0.7.3,- ghc-typelits-natnormalise >= 0.2+ clash-lib >= 0.5.5,+ clash-vhdl >= 0.5.4,+ clash-systemverilog >= 0.5.4,+ clash-prelude >= 0.7.5,+ ghc-typelits-natnormalise >= 0.2.1 if os(windows) Build-Depends: Win32@@ -88,6 +87,7 @@ GhciMonad GhciTags + CLaSH.GHC.CLaSHFlags CLaSH.GHC.Evaluator CLaSH.GHC.GenerateBindings CLaSH.GHC.GHC2Core
src-bin/InteractiveUI.hs view
@@ -113,11 +113,11 @@ import CLaSH.Backend.VHDL (VHDLState) import CLaSH.Backend.SystemVerilog (SystemVerilogState) import qualified CLaSH.Driver+import CLaSH.Driver.Types (CLaSHOpts) import CLaSH.GHC.Evaluator import CLaSH.GHC.GenerateBindings import CLaSH.GHC.NetlistTypes import qualified CLaSH.Primitives.Util-import CLaSH.Rewrite.Types (DebugLevel(..)) import CLaSH.Util (clashLibVersion) import qualified Data.Version as Data.Version import qualified Paths_clash_ghc@@ -132,10 +132,10 @@ defPrompt2 :: String } -defaultGhciSettings :: GhciSettings-defaultGhciSettings =+defaultGhciSettings :: IORef CLaSHOpts -> GhciSettings+defaultGhciSettings opts = GhciSettings {- availableCommands = ghciCommands,+ availableCommands = ghciCommands opts, shortHelpText = defShortHelpText, fullHelpText = defFullHelpText, defPrompt = default_prompt,@@ -152,8 +152,8 @@ GLOBAL_VAR(macros_ref, [], [Command]) -ghciCommands :: [Command]-ghciCommands = [+ghciCommands :: IORef CLaSHOpts -> [Command]+ghciCommands opts = [ -- Hugs users are accustomed to :e, so make sure it doesn't overlap ("?", keepGoing help, noCompletion), ("add", keepGoingPaths addModule, completeFilename),@@ -204,8 +204,8 @@ ("trace", keepGoing traceCmd, completeExpression), ("undef", keepGoing undefineMacro, completeMacro), ("unset", keepGoing unsetOptions, completeSetOptions),- ("vhdl", keepGoingPaths makeVHDL, completeHomeModuleOrFile),- ("systemverilog", keepGoingPaths makeSystemVerilog, completeHomeModuleOrFile)+ ("vhdl", keepGoingPaths (makeVHDL opts), completeHomeModuleOrFile),+ ("systemverilog", keepGoingPaths (makeSystemVerilog opts), completeHomeModuleOrFile) ] @@ -1556,9 +1556,10 @@ makeHDL' :: CLaSH.Backend.Backend backend => backend+ -> IORef CLaSHOpts -> [FilePath] -> InputT GHCi ()-makeHDL' backend lst = makeHDL backend =<< case lst of+makeHDL' backend opts lst = makeHDL backend opts =<< case lst of srcs@(_:_) -> return srcs [] -> do modGraph <- GHC.getModuleGraph@@ -1570,21 +1571,23 @@ makeHDL :: GHC.GhcMonad m => CLaSH.Backend.Backend backend => backend+ -> IORef CLaSHOpts -> [FilePath] -> m ()-makeHDL backend srcs = do+makeHDL backend optsRef srcs = do dflags <- GHC.getSessionDynFlags- liftIO $ do primDir <- CLaSH.Backend.primDir backend+ liftIO $ do opts <- readIORef optsRef+ primDir <- CLaSH.Backend.primDir backend primMap <- CLaSH.Primitives.Util.generatePrimMap [primDir,"."] forM_ srcs $ \src -> do (bindingsMap,tcm,topEntM) <- generateBindings primMap src (Just dflags) CLaSH.Driver.generateHDL bindingsMap (Just backend) primMap tcm- ghcTypeToHWType reduceConstant topEntM DebugNone+ ghcTypeToHWType reduceConstant topEntM opts -makeVHDL :: [FilePath] -> InputT GHCi ()+makeVHDL :: IORef CLaSHOpts -> [FilePath] -> InputT GHCi () makeVHDL = makeHDL' (CLaSH.Backend.initBackend :: VHDLState) -makeSystemVerilog :: [FilePath] -> InputT GHCi ()+makeSystemVerilog :: IORef CLaSHOpts -> [FilePath] -> InputT GHCi () makeSystemVerilog = makeHDL' (CLaSH.Backend.initBackend :: SystemVerilogState) -----------------------------------------------------------------------------
src-bin/Main.hs view
@@ -68,12 +68,16 @@ import Paths_clash_ghc import InteractiveUI (makeHDL) import Exception (gcatch)+import Data.IORef (IORef, newIORef) import qualified Data.Version (showVersion) import Control.Exception (ErrorCall (..)) import qualified CLaSH.Backend import CLaSH.Backend.VHDL (VHDLState) import CLaSH.Backend.SystemVerilog (SystemVerilogState)+import CLaSH.Driver.Types (CLaSHOpts (..))+import CLaSH.GHC.CLaSHFlags+import CLaSH.Rewrite.Types (DebugLevel (..)) import CLaSH.Util (clashLibVersion) ghcLibDir :: IO FilePath@@ -118,10 +122,16 @@ let argv1 = map (mkGeneralLocated "on the commandline") argv0 (argv2, staticFlagWarnings) <- parseStaticFlags argv1 + r <- newIORef (CLaSHOpts { opt_dbgLevel = DebugNone+ , opt_inlineLimit = 20+ , opt_specLimit = 20+ })+ (argv3, clashFlagWarnings) <- parseCLaSHFlags r argv2+ -- 2. Parse the "mode" flags (--make, --interactive etc.)- (mode, argv3, modeFlagWarnings) <- parseModeFlags argv2+ (mode, argv4, modeFlagWarnings) <- parseModeFlags argv3 - let flagWarnings = staticFlagWarnings ++ modeFlagWarnings+ let flagWarnings = staticFlagWarnings ++ modeFlagWarnings ++ clashFlagWarnings -- If all we want to do is something like showing the version number -- then do it now, before we start a GHC session etc. This makes@@ -175,11 +185,12 @@ ShowGhciUsage -> showGhciUsage dflagsExtra2 PrintWithDynFlags f -> putStrLn (f dflagsExtra2) Right postLoadMode ->- main' postLoadMode dflagsExtra2 argv3 flagWarnings+ main' postLoadMode dflagsExtra2 argv4 flagWarnings r main' :: PostLoadMode -> DynFlags -> [Located String] -> [Located String]+ -> IORef CLaSHOpts -> Ghc ()-main' postLoadMode dflags0 args flagWarnings = do+main' postLoadMode dflags0 args flagWarnings clashOpts = do -- set the default GhcMode, HscTarget and GhcLink. The HscTarget -- can be further adjusted on a module by module basis, using only -- the -fvia-C and -fasm flags. If the default HscTarget is not@@ -280,14 +291,14 @@ handleSourceError (\e -> do GHC.printException e liftIO $ exitWith (ExitFailure 1)) $ do- let clash fun = gcatch (fun srcs) (\(ErrorCall e) -> throwOneError $ mkPlainErrMsg dflags6 noSrcSpan (text ("CLaSH Error:\n" ++ e)))+ let clash fun = gcatch (fun clashOpts srcs) (\(ErrorCall e) -> throwOneError $ mkPlainErrMsg dflags6 noSrcSpan (text ("CLaSH Error:\n" ++ e))) case postLoadMode of ShowInterface f -> liftIO $ doShowIface dflags6 f DoMake -> doMake srcs DoMkDependHS -> doMkDependHS (map fst srcs) StopBefore p -> liftIO (oneShot hsc_env p srcs)- DoInteractive -> ghciUI srcs Nothing- DoEval exprs -> ghciUI srcs $ Just $ reverse exprs+ DoInteractive -> ghciUI clashOpts srcs Nothing+ DoEval exprs -> ghciUI clashOpts srcs $ Just $ reverse exprs DoAbiHash -> abiHash (map fst srcs) ShowPackages -> liftIO $ showPackages dflags6 DoVHDL -> clash makeVHDL@@ -295,11 +306,11 @@ liftIO $ dumpFinalStats dflags6 -ghciUI :: [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc ()+ghciUI :: IORef CLaSHOpts -> [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc () #ifndef GHCI-ghciUI _ _ = throwGhcException (CmdLineError "not built for interactive use")+ghciUI _ _ _ = throwGhcException (CmdLineError "not built for interactive use") #else-ghciUI = interactiveUI defaultGhciSettings+ghciUI opts = interactiveUI (defaultGhciSettings opts) #endif -- -----------------------------------------------------------------------------@@ -921,14 +932,14 @@ -- ----------------------------------------------------------------------------- -- VHDL Generation -makeHDL' :: CLaSH.Backend.Backend backend => backend -> [(String,Maybe Phase)] -> Ghc ()-makeHDL' _ [] = throwGhcException (CmdLineError "No input files")-makeHDL' backend srcs = makeHDL backend $ fmap fst srcs+makeHDL' :: CLaSH.Backend.Backend backend => backend -> IORef CLaSHOpts -> [(String,Maybe Phase)] -> Ghc ()+makeHDL' _ _ [] = throwGhcException (CmdLineError "No input files")+makeHDL' backend r srcs = makeHDL backend r $ fmap fst srcs -makeVHDL :: [(String, Maybe Phase)] -> Ghc ()+makeVHDL :: IORef CLaSHOpts -> [(String, Maybe Phase)] -> Ghc () makeVHDL = makeHDL' (CLaSH.Backend.initBackend :: VHDLState) -makeSystemVerilog :: [(String, Maybe Phase)] -> Ghc ()+makeSystemVerilog :: IORef CLaSHOpts -> [(String, Maybe Phase)] -> Ghc () makeSystemVerilog = makeHDL' (CLaSH.Backend.initBackend :: SystemVerilogState) -- -----------------------------------------------------------------------------
+ src-ghc/CLaSH/GHC/CLaSHFlags.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE TupleSections #-}+module CLaSH.GHC.CLaSHFlags+ ( parseCLaSHFlags+ )+where++import CmdLineParser+import Panic+import SrcLoc++import Data.IORef+import Control.Monad+import CLaSH.Driver.Types+import Text.Read (readMaybe)++parseCLaSHFlags :: IORef CLaSHOpts -> [Located String]+ -> IO ([Located String],[Located String])+parseCLaSHFlags r = parseCLaSHFlagsFull (flagsClash r)++parseCLaSHFlagsFull :: [Flag IO] -> [Located String]+ -> IO ([Located String],[Located String])+parseCLaSHFlagsFull flagsAvialable args = do+ (leftovers,errs,warns) <- processArgs flagsAvialable args++ unless (null errs) $ throwGhcExceptionIO $+ errorsToGhcException . map (("on the commandline", ) . unLoc) $ errs++ return (leftovers, warns)++flagsClash :: IORef CLaSHOpts -> [Flag IO]+flagsClash r = [+ defFlag "clash-inline-limit" (IntSuffix (liftEwM . setInlineLimit r))+ , defFlag "clash-spec-limit" (IntSuffix (liftEwM . setSpecLimit r))+ , defFlag "clash-debug" (SepArg (setDebugLevel r))+ ]++setInlineLimit :: IORef CLaSHOpts+ -> Int+ -> IO ()+setInlineLimit r n = modifyIORef r (\c -> c {opt_inlineLimit = n})++setSpecLimit :: IORef CLaSHOpts+ -> Int+ -> IO ()+setSpecLimit r n = modifyIORef r (\c -> c {opt_specLimit = n})++setDebugLevel :: IORef CLaSHOpts+ -> String+ -> EwM IO ()+setDebugLevel r s = case readMaybe s of+ Just dbgLvl -> liftEwM $ modifyIORef r (\c -> c {opt_dbgLevel = dbgLvl})+ Nothing -> addWarn (s ++ " is an invalid debug level")
src-ghc/CLaSH/GHC/Evaluator.hs view
@@ -9,7 +9,7 @@ import qualified Data.List as List import Unbound.Generics.LocallyNameless (bind, embed, string2Name) -import CLaSH.Core.DataCon (dcTag)+import CLaSH.Core.DataCon (DataCon (..)) import CLaSH.Core.Literal (Literal (..)) import CLaSH.Core.Term (Term (..)) import CLaSH.Core.Type (Type (..), ConstTy (..), mkFunTy)@@ -68,6 +68,11 @@ [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] -> Literal (IntegerLiteral (i * j)) _ -> e+ | nm == "GHC.Integer.Type.minusInteger"+ = case (map (reduceConstant tcm) . Either.lefts) args of+ [Literal (IntegerLiteral i), Literal (IntegerLiteral j)]+ -> Literal (IntegerLiteral (i - j))+ _ -> e | nm == "GHC.Integer.Type.divInteger" = case (map (reduceConstant tcm) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)]@@ -119,6 +124,10 @@ = case (map (reduceConstant tcm) . Either.lefts) args of [Literal (IntegerLiteral i), _] -> Literal (IntegerLiteral i) _ -> e+ | nm == "CLaSH.Promoted.Nat.SNat"+ = case (map collectArgs . Either.lefts) args of+ [(Literal (IntegerLiteral _),[]), (Data _,_)] -> mkApps snatCon args+ _ -> e reduceConstant _ e = e @@ -141,3 +150,18 @@ nName = string2Name "n" nVar = VarTy typeNatKind nName nTV = TyVar nName (embed typeNatKind)++snatCon :: Term+snatCon = Data (MkData snanNm 1 snatTy [nName] [] argTys)+ where+ snanNm = string2Name "CLaSH.Promoted.Nat.SNat"+ snatTy = ForAllTy (bind nTV funTy)+ argTys = [ConstTy (TyCon (string2Name "GHC.Integer.Type.Integer"))+ ,AppTy (AppTy (ConstTy (TyCon (string2Name "Data.Proxy.Proxy"))) typeNatKind)+ nVar+ ]+ funTy = foldr mkFunTy (ConstTy (TyCon (string2Name "CLaSH.Promoted.Nat.SNat"))) argTys+ nName = string2Name "n"+ nVar = VarTy typeNatKind nName+ nTV = TyVar nName (embed typeNatKind)+