clash-ghc 0.6 → 0.6.1
raw patch · 9 files changed
+76/−35 lines, 9 filesdep ~clash-libdep ~clash-preludedep ~clash-systemverilog
Dependency ranges changed: clash-lib, clash-prelude, clash-systemverilog, clash-verilog, clash-vhdl
Files
- CHANGELOG.md +29/−0
- clash-ghc.cabal +6/−6
- src-bin/InteractiveUI.hs +2/−2
- src-bin/Main.hs +1/−18
- src-ghc/CLaSH/GHC/Evaluator.hs +9/−0
- src-ghc/CLaSH/GHC/GHC2Core.hs +3/−0
- src-ghc/CLaSH/GHC/GenerateBindings.hs +22/−6
- src-ghc/CLaSH/GHC/LoadModules.hs +2/−1
- src-ghc/CLaSH/GHC/NetlistTypes.hs +2/−2
CHANGELOG.md view
@@ -1,5 +1,34 @@ # Changelog for the [`clash-ghc`](http://hackage.haskell.org/package/clash-ghc) package +## 0.6.1 *October 16th 2015*+* New features:+ * Support for `clash-prelude` 0.10.1+ * Transformation that lifts applications of the same function out of alternatives of case-statements. e.g.++ ```haskell+ case x of+ A -> f 3 y+ B -> f x x+ C -> h x+ ```++ is transformed into:++ ```haskell+ let f_arg0 = case x of {A -> 3; B -> x}+ f_arg1 = case x of {A -> y; B -> x}+ f_out = f f_arg0 f_arg1+ in case x of+ A -> f_out+ B -> f_out+ C -> h x+ ```++* Fixes bugs:+ * clash won't run when not compiled with usual ghc [#82](https://github.com/clash-lang/clash-compiler/issues/82)+ * Fail to generate VHDL with blockRamFile' in clash-ghc 0.6 [#85](https://github.com/clash-lang/clash-compiler/issues/85)+ * Case-statements acting like normal decoder circuits are erroneously synthesised to priority decoder circuits.+ ## 0.6 *October 3rd 2015* * New features: * Support `clash-prelude-0.10`
clash-ghc.cabal view
@@ -1,5 +1,5 @@ Name: clash-ghc-Version: 0.6+Version: 0.6.1 Synopsis: CAES Language for Synchronous Hardware Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -94,11 +94,11 @@ unbound-generics >= 0.1 && < 0.3, unordered-containers >= 0.2.1.0, - clash-lib >= 0.6 && < 0.7,- clash-systemverilog >= 0.6,- clash-vhdl >= 0.6,- clash-verilog >= 0.6,- clash-prelude >= 0.10,+ clash-lib >= 0.6.1 && < 0.7,+ clash-systemverilog >= 0.6.1,+ clash-vhdl >= 0.6.1,+ clash-verilog >= 0.6.1,+ clash-prelude >= 0.10.1, ghc-typelits-natnormalise >= 0.3 if os(windows)
src-bin/InteractiveUI.hs view
@@ -1584,9 +1584,9 @@ primDir <- CLaSH.Backend.primDir backend primMap <- CLaSH.Primitives.Util.generatePrimMap [primDir,"."] forM_ srcs $ \src -> do- (bindingsMap,tcm,topEntM) <- generateBindings primMap src (Just dflags)+ (bindingsMap,tcm,tupTcm,topEntM) <- generateBindings primMap src (Just dflags) CLaSH.Driver.generateHDL bindingsMap (Just backend) primMap tcm- ghcTypeToHWType reduceConstant topEntM opts+ tupTcm ghcTypeToHWType reduceConstant topEntM opts makeVHDL :: IORef CLaSHOpts -> [FilePath] -> InputT GHCi () makeVHDL = makeHDL' (CLaSH.Backend.initBackend :: VHDLState)
src-bin/Main.hs view
@@ -64,7 +64,6 @@ import Data.Maybe -- clash additions-import System.Process (runInteractiveCommand, waitForProcess) import Paths_clash_ghc import InteractiveUI (makeHDL) import Exception (gcatch)@@ -80,23 +79,7 @@ import CLaSH.GHC.CLaSHFlags import CLaSH.Rewrite.Types (DebugLevel (..)) import CLaSH.Util (clashLibVersion)--ghcLibDir :: IO FilePath-ghcLibDir = do (libDir,exitCode) <- getProcessOutput "ghc --print-libdir"- case exitCode of- ExitSuccess -> return libDir- ExitFailure i -> error $ "Calling GHC failed with: " ++ show i--getProcessOutput :: String -> IO (String, ExitCode)-getProcessOutput command =- -- Create the process- do (_, pOut, _, handle) <- runInteractiveCommand command- -- Wait for the process to finish and store its exit code- exitCode <- waitForProcess handle- -- Get the standard output.- output <- hGetLine pOut- -- return both the output and the exit code.- return (output, exitCode)+import CLaSH.GHC.LoadModules (ghcLibDir) ----------------------------------------------------------------------------- -- ToDo:
src-ghc/CLaSH/GHC/Evaluator.hs view
@@ -71,6 +71,15 @@ [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] -> Literal (IntegerLiteral (i * j)) _ -> e+ | nm == "GHC.Integer.Type.eqInteger"+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of+ [Literal (IntegerLiteral i), Literal (IntegerLiteral j)]+ -> let (_,tyView -> TyConApp boolTcNm []) = splitFunForallTy ty+ (Just boolTc) = HashMap.lookup boolTcNm tcm+ [falseDc,trueDc] = tyConDataCons boolTc+ retDc = if i == j then trueDc else falseDc+ in Data retDc+ _ -> e | nm == "GHC.Integer.Type.minusInteger" = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)]
src-ghc/CLaSH/GHC/GHC2Core.hs view
@@ -8,8 +8,11 @@ module CLaSH.GHC.GHC2Core ( GHC2CoreState+ , tyConMap , coreToTerm , coreToId+ , coreToName+ , qualfiedNameString , makeAllTyCons , emptyGHC2CoreState )
src-ghc/CLaSH/GHC/GenerateBindings.hs view
@@ -2,18 +2,24 @@ (generateBindings) where +import Control.Lens ((%~),(&)) import Control.Monad.State (State) import qualified Control.Monad.State as State import Data.Either (lefts, rights) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap+import Data.IntMap.Strict (IntMap)+import qualified Data.IntMap.Strict as IM import Data.List (isSuffixOf) import qualified Data.Set as Set import qualified Data.Set.Lens as Lens import Unbound.Generics.LocallyNameless (name2String, runFreshM, unembed) +import qualified BasicTypes as GHC import qualified CoreSyn as GHC import qualified DynFlags as GHC+import qualified TyCon as GHC+import qualified TysWiredIn as GHC import CLaSH.Annotations.TopEntity (TopEntity) import CLaSH.Core.FreeVars (termFreeIds)@@ -25,8 +31,8 @@ import CLaSH.Core.Util (mkLams, mkTyLams, termType) import CLaSH.Core.Var (Var (..)) import CLaSH.Driver.Types (BindingMap)-import CLaSH.GHC.GHC2Core (GHC2CoreState, coreToId, coreToTerm,- makeAllTyCons, emptyGHC2CoreState)+import CLaSH.GHC.GHC2Core (GHC2CoreState, tyConMap, coreToId, coreToName, coreToTerm,+ makeAllTyCons, qualfiedNameString, emptyGHC2CoreState) import CLaSH.GHC.LoadModules (loadModules) import CLaSH.Normalize.Util import CLaSH.Primitives.Types (PrimMap)@@ -37,16 +43,17 @@ PrimMap -> String -> Maybe (GHC.DynFlags)- -> IO (BindingMap,HashMap TyConName TyCon,Maybe TopEntity)+ -> IO (BindingMap,HashMap TyConName TyCon,IntMap TyConName,Maybe TopEntity) generateBindings primMap modName dflagsM = do (bindings,clsOps,unlocatable,fiEnvs,topEntM) <- loadModules modName dflagsM let ((bindingsMap,clsVMap),tcMap) = State.runState (mkBindings primMap bindings clsOps unlocatable) emptyGHC2CoreState- tcCache = makeAllTyCons tcMap fiEnvs+ (tcMap',tupTcCache) = mkTupTyCons tcMap+ tcCache = makeAllTyCons tcMap' fiEnvs allTcCache = tysPrimMap `HashMap.union` tcCache clsMap = HashMap.map (\(ty,i) -> (ty,mkClassSelector allTcCache ty i)) clsVMap allBindings = bindingsMap `HashMap.union` clsMap droppedAndRetypedBindings = dropAndRetypeBindings allTcCache allBindings- return (droppedAndRetypedBindings,allTcCache,topEntM)+ return (droppedAndRetypedBindings,allTcCache,tupTcCache,topEntM) dropAndRetypeBindings :: HashMap TyConName TyCon -> BindingMap -> BindingMap dropAndRetypeBindings allTcCache allBindings = oBindings@@ -131,7 +138,7 @@ newExpr = case coreView tcm dictTy of (TyConApp _ _) -> runFreshM $ flip State.evalStateT (0 :: Int) $ do (dcId,dcVar) <- mkInternalVar "dict" dictTy- selE <- mkSelectorCase "mkClassSelector" tcm [] dcVar 1 sel+ selE <- mkSelectorCase "mkClassSelector" tcm dcVar 1 sel return (mkTyLams (mkLams selE [dcId]) tvs) (FunTy arg res) -> runFreshM $ flip State.evalStateT (0 :: Int) $ do (dcId,dcVar) <- mkInternalVar "dict" (mkFunTy arg res)@@ -139,3 +146,12 @@ (OtherType oTy) -> runFreshM $ flip State.evalStateT (0 :: Int) $ do (dcId,dcVar) <- mkInternalVar "dict" oTy return (mkTyLams (mkLams dcVar [dcId]) tvs)++mkTupTyCons :: GHC2CoreState -> (GHC2CoreState,IntMap TyConName)+mkTupTyCons tcMap = (tcMap'',tupTcCache)+ where+ tupTyCons = map (GHC.tupleTyCon GHC.BoxedTuple) [2..62]+ (tcNames,tcMap') = State.runState (mapM (\tc -> coreToName GHC.tyConName GHC.tyConUnique qualfiedNameString tc) tupTyCons) tcMap+ tupTcCache = IM.fromList (zip [2..62] tcNames)+ tupHM = HashMap.fromList (zip tcNames tupTyCons)+ tcMap'' = tcMap' & tyConMap %~ (`HashMap.union` tupHM)
src-ghc/CLaSH/GHC/LoadModules.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE TemplateHaskell #-} module CLaSH.GHC.LoadModules ( loadModules+ , ghcLibDir ) where @@ -41,7 +42,7 @@ import CLaSH.Util (curLoc,first) ghcLibDir :: IO FilePath-ghcLibDir = do (libDir,exitCode) <- getProcessOutput "ghc --print-libdir"+ghcLibDir = do (libDir,exitCode) <- getProcessOutput $ "ghc-" ++ TOOL_VERSION_ghc ++ " --print-libdir" case exitCode of ExitSuccess -> return libDir ExitFailure i -> error $ "Calling GHC failed with: " ++ show i
src-ghc/CLaSH/GHC/NetlistTypes.hs view
@@ -53,9 +53,9 @@ elHWTy <- ExceptT $ return $ coreTypeToHWType ghcTypeToHWType m elTy return $ Vector sz elHWTy - "String" -> return Void+ "String" -> return String "GHC.Types.[]" -> case tyView (head args) of- (TyConApp (name2String -> "GHC.Types.Char") []) -> return Void+ (TyConApp (name2String -> "GHC.Types.Char") []) -> return String _ -> fail $ "Can't translate type: " ++ showDoc ty _ -> case m ! tc of