clash-lib 0.6.8 → 0.6.9
raw patch · 45 files changed
+667/−153 lines, 45 files
Files
- CHANGELOG.md +5/−0
- clash-lib.cabal +2/−2
- src/CLaSH/Backend.hs +10/−0
- src/CLaSH/Core/DataCon.hs +8/−1
- src/CLaSH/Core/FreeVars.hs +8/−1
- src/CLaSH/Core/Literal.hs +8/−1
- src/CLaSH/Core/Pretty.hs +9/−1
- src/CLaSH/Core/Subst.hs +8/−1
- src/CLaSH/Core/Term.hs +8/−1
- src/CLaSH/Core/Term.hs-boot +6/−0
- src/CLaSH/Core/TyCon.hs +8/−1
- src/CLaSH/Core/TyCon.hs-boot +6/−0
- src/CLaSH/Core/Type.hs +31/−3
- src/CLaSH/Core/Type.hs-boot +6/−0
- src/CLaSH/Core/TysPrim.hs +8/−1
- src/CLaSH/Core/Util.hs +8/−1
- src/CLaSH/Core/Var.hs +8/−1
- src/CLaSH/Driver.hs +29/−6
- src/CLaSH/Driver/TestbenchGen.hs +18/−11
- src/CLaSH/Driver/TopWrapper.hs +11/−9
- src/CLaSH/Driver/Types.hs +8/−1
- src/CLaSH/Netlist.hs +11/−3
- src/CLaSH/Netlist.hs-boot +6/−0
- src/CLaSH/Netlist/BlackBox.hs +30/−26
- src/CLaSH/Netlist/BlackBox/Parser.hs +15/−2
- src/CLaSH/Netlist/BlackBox/Types.hs +9/−1
- src/CLaSH/Netlist/BlackBox/Util.hs +125/−5
- src/CLaSH/Netlist/Id.hs +9/−1
- src/CLaSH/Netlist/Types.hs +9/−2
- src/CLaSH/Netlist/Util.hs +8/−1
- src/CLaSH/Normalize.hs +17/−5
- src/CLaSH/Normalize/DEC.hs +28/−25
- src/CLaSH/Normalize/PrimitiveReductions.hs +27/−20
- src/CLaSH/Normalize/Strategy.hs +10/−2
- src/CLaSH/Normalize/Transformations.hs +60/−2
- src/CLaSH/Normalize/Types.hs +15/−4
- src/CLaSH/Normalize/Util.hs +8/−1
- src/CLaSH/Primitives/Types.hs +13/−5
- src/CLaSH/Primitives/Util.hs +10/−2
- src/CLaSH/Rewrite/Combinators.hs +8/−1
- src/CLaSH/Rewrite/Types.hs +8/−1
- src/CLaSH/Rewrite/Util.hs +8/−1
- src/CLaSH/Util.hs +8/−1
- src/Data/Aeson/Extra.hs +6/−0
- src/Unbound/Generics/LocallyNameless/Extra.hs +6/−0
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Changelog for the [`clash-lib`](http://hackage.haskell.org/package/clash-lib) package +## 0.6.9+* Fixes bugs:+ * `case undefined of ...` should reduce to `undefined` [#116](https://github.com/clash-lang/clash-compiler/issues/109)+ * Type families obscure eligibility for synthesis [#114](https://github.com/clash-lang/clash-compiler/issues/114)+ ## 0.6.8 *January 13th 2015* * New features: * Support for Haskell's: `Char`, `Int8`, `Int16`, `Int32`, `Int64`, `Word`, `Word8`, `Word16`, `Word32`, `Word64`.
clash-lib.cabal view
@@ -1,5 +1,5 @@ Name: clash-lib-Version: 0.6.8+Version: 0.6.9 Synopsis: CAES Language for Synchronous Hardware - As a Library Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -49,7 +49,7 @@ License-file: LICENSE Author: Christiaan Baaij Maintainer: Christiaan Baaij <christiaan.baaij@gmail.com>-Copyright: Copyright © 2012-2015 University of Twente+Copyright: Copyright © 2012-2016 University of Twente Category: Hardware Build-type: Simple
src/CLaSH/Backend.hs view
@@ -1,3 +1,9 @@+{-|+ Copyright : (C) 2015-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-}+ module CLaSH.Backend where import Data.HashSet (HashSet)@@ -44,3 +50,7 @@ expr :: Bool -> Expr -> State state Doc -- | Bit-width of Int/Word/Integer iwWidth :: State state Int+ -- | Convert to a bit-vector+ toBV :: HWType -> Text -> State state Doc+ -- | Convert from a bit-vector+ fromBV :: HWType -> Text -> State state Doc
src/CLaSH/Core/DataCon.hs view
@@ -1,3 +1,11 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Data Constructors in CoreHW+-}+ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-}@@ -5,7 +13,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} --- | Data Constructors in CoreHW module CLaSH.Core.DataCon ( DataCon (..) , DcName
src/CLaSH/Core/FreeVars.hs view
@@ -1,4 +1,11 @@--- | Free variable calculations+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Free variable calculations+-}+ module CLaSH.Core.FreeVars where import Control.Lens.Fold (Fold)
src/CLaSH/Core/Literal.hs view
@@ -1,9 +1,16 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Term Literal+-}+ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} --- | Term Literal module CLaSH.Core.Literal ( Literal (..) , literalType
src/CLaSH/Core/Pretty.hs view
@@ -1,7 +1,15 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Pretty printing class and instances for CoreHW+-}+ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-}--- | Pretty printing class and instances for CoreHW+ module CLaSH.Core.Pretty ( Pretty (..) , showDoc
src/CLaSH/Core/Subst.hs view
@@ -1,4 +1,11 @@--- | Capture-free substitution function for CoreHW+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Capture-free substitution function for CoreHW+-}+ module CLaSH.Core.Subst where import Unbound.Generics.LocallyNameless (subst, substs)
src/CLaSH/Core/Term.hs view
@@ -1,3 +1,11 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Term representation in the CoreHW language: System F + LetRec + Case+-}+ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-}@@ -6,7 +14,6 @@ {-# OPTIONS_GHC -fno-specialise #-} --- | Term representation in the CoreHW language: System F + LetRec + Case module CLaSH.Core.Term ( Term (..) , TmName
src/CLaSH/Core/Term.hs-boot view
@@ -1,3 +1,9 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-}+ {-# OPTIONS_GHC -fno-warn-missing-methods #-} module CLaSH.Core.Term where
src/CLaSH/Core/TyCon.hs view
@@ -1,10 +1,17 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Type Constructors in CoreHW+-}+ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} --- | Type Constructors in CoreHW module CLaSH.Core.TyCon ( TyCon (..) , TyConName
src/CLaSH/Core/TyCon.hs-boot view
@@ -1,3 +1,9 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-}+ module CLaSH.Core.TyCon where import Unbound.Generics.LocallyNameless (Name)
src/CLaSH/Core/Type.hs view
@@ -1,3 +1,11 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Types in CoreHW+-}+ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-}@@ -7,7 +15,6 @@ {-# OPTIONS_GHC -fno-specialise #-} --- | Types in CoreHW module CLaSH.Core.Type ( Type (..) , TypeView (..)@@ -28,6 +35,7 @@ , splitFunTy , splitFunTys , splitFunForallTy+ , splitCoreFunForallTy , splitTyConAppM , isPolyFunTy , isPolyFunCoreTy@@ -36,6 +44,7 @@ , applyFunTy , applyTy , findFunSubst+ , undefinedTy ) where @@ -48,10 +57,11 @@ import GHC.Generics (Generic(..)) import Unbound.Generics.LocallyNameless (Alpha(..),Bind,Fresh, Subst(..),SubstName(..),- acompare,aeq,bind,+ acompare,aeq,bind,embed, gacompare,gaeq,gfvAny, runFreshM,unbind)-import Unbound.Generics.LocallyNameless.Name (Name,name2String)+import Unbound.Generics.LocallyNameless.Name (Name,name2String,+ string2Name) import Unbound.Generics.LocallyNameless.Extra () import Unbound.Generics.LocallyNameless.Unsafe (unsafeUnbind) @@ -255,6 +265,18 @@ go args (tyView -> FunTy arg res) = go (Right arg:args) res go args ty = (reverse args,ty) +-- | Split a poly-function type in a: list of type-binders and argument types,+-- and the result type. Looks through 'Signal' and type functions.+splitCoreFunForallTy :: HashMap TyConName TyCon+ -> Type+ -> ([Either TyVar Type], Type)+splitCoreFunForallTy tcm = go []+ where+ go args (ForAllTy b) = let (tv, ty) = runFreshM $ unbind b+ in go (Left tv:args) ty+ go args (coreView tcm -> FunTy arg res) = go (Right arg:args) res+ go args ty = (reverse args, ty)+ -- | Is a type a polymorphic or function type? isPolyFunTy :: Type -> Bool@@ -336,3 +358,9 @@ tySubts <- zipWithM funSubst argTys argTys' return (concat tySubts) funSubst _ _ = Nothing++-- | The type of GHC.Err.undefined :: forall a . a+undefinedTy :: Type+undefinedTy =+ let aNm = string2Name "a"+ in ForAllTy (bind (TyVar aNm (embed liftedTypeKind)) (VarTy liftedTypeKind aNm))
src/CLaSH/Core/Type.hs-boot view
@@ -1,3 +1,9 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-}+ {-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-missing-methods #-}
src/CLaSH/Core/TysPrim.hs view
@@ -1,4 +1,11 @@--- | Builtin Type and Kind definitions+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Builtin Type and Kind definitions+-}+ module CLaSH.Core.TysPrim ( liftedTypeKind , typeNatKind
src/CLaSH/Core/Util.hs view
@@ -1,8 +1,15 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Smart constructor and destructor functions for CoreHW+-}+ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} --- | Smart constructor and destructor functions for CoreHW module CLaSH.Core.Util where import Control.Monad.Trans.Except (Except, throwE)
src/CLaSH/Core/Var.hs view
@@ -1,8 +1,15 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Variables in CoreHW+-}+ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} --- | Variables in CoreHW module CLaSH.Core.Var ( Var (..) , Id
src/CLaSH/Driver.hs view
@@ -1,7 +1,14 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Module that connects all the parts of the CLaSH compiler library+-}+ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} --- | Module that connects all the parts of the CLaSH compiler library module CLaSH.Driver where import qualified Control.Concurrent.Supply as Supply@@ -9,9 +16,11 @@ import Control.Monad (when) import Control.Monad.State (evalState, get) import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HashSet import Data.IntMap (IntMap) import Data.Maybe (fromMaybe)+import Data.Text.Lazy (Text) import qualified Data.Text.Lazy as Text import qualified Data.Time.Clock as Clock import qualified System.Directory as Directory@@ -29,16 +38,19 @@ import CLaSH.Driver.TopWrapper import CLaSH.Driver.Types import CLaSH.Netlist (genComponentName, genNetlist)+import CLaSH.Netlist.BlackBox.Parser (runParse)+import CLaSH.Netlist.BlackBox.Types (BlackBoxTemplate) import CLaSH.Netlist.Types (Component (..), HWType) import CLaSH.Normalize (checkNonRecursive, cleanupGraph, normalize, runNormalization) import CLaSH.Primitives.Types+import CLaSH.Util (first) -- | Create a set of target HDL files for a set of functions generateHDL :: forall backend . Backend backend => BindingMap -- ^ Set of functions -> Maybe backend- -> PrimMap -- ^ Primitive / BlackBox Definitions+ -> PrimMap (Text.Text) -- ^ Primitive / BlackBox Definitions -> HashMap TyConName TyCon -- ^ TyCon cache -> IntMap TyConName -- ^ Tuple TyCon cache -> (HashMap TyConName TyCon -> Type -> Maybe (Either String HWType)) -- ^ Hardcoded 'Type' -> 'HWType' translator@@ -52,6 +64,9 @@ start <- Clock.getCurrentTime prepTime <- start `deepseq` bindingsMap `deepseq` tcm `deepseq` Clock.getCurrentTime let prepStartDiff = Clock.diffUTCTime prepTime start++ primMap' = (HM.map parsePrimitive :: PrimMap Text.Text -> PrimMap BlackBoxTemplate) primMap+ putStrLn $ "Loading dependencies took " ++ show prepStartDiff (supplyN,supplyTB) <- Supply.splitSupply@@ -62,7 +77,7 @@ let doNorm = do norm <- normalize [topEntity] let normChecked = checkNonRecursive topEntity norm cleanupGraph topEntity normChecked- transformedBindings = runNormalization opts supplyN bindingsMap typeTrans tcm tupTcm eval doNorm+ transformedBindings = runNormalization opts supplyN bindingsMap typeTrans tcm tupTcm eval primMap' doNorm normTime <- transformedBindings `deepseq` Clock.getCurrentTime let prepNormDiff = Clock.diffUTCTime normTime prepTime@@ -70,7 +85,7 @@ let modName = takeWhile (/= '.') (name2String topEntity) iw = opt_intWidth opts- (netlist,dfiles,cmpCnt) <- genNetlist Nothing transformedBindings primMap tcm+ (netlist,dfiles,cmpCnt) <- genNetlist Nothing transformedBindings primMap' tcm typeTrans Nothing modName [] iw topEntity netlistTime <- netlist `deepseq` Clock.getCurrentTime@@ -83,7 +98,7 @@ cName) netlist - (testBench,dfiles') <- genTestBench opts supplyTB primMap+ (testBench,dfiles') <- genTestBench opts supplyTB primMap' typeTrans tcm tupTcm eval cmpCnt bindingsMap testInpM expOutM@@ -97,7 +112,7 @@ putStrLn $ "Testbench generation took " ++ show netTBDiff let hdlState' = fromMaybe (initBackend iw :: backend) hdlState- topWrapper = mkTopWrapper primMap annM modName iw topComponent+ topWrapper = mkTopWrapper primMap' annM modName iw topComponent hdlDocs = createHDL hdlState' modName (topWrapper : netlist ++ testBench) dir = concat [ "./" ++ CLaSH.Backend.name hdlState' ++ "/" , takeWhile (/= '.') (name2String topEntity)@@ -110,6 +125,14 @@ end <- hdlDocs `seq` Clock.getCurrentTime let startEndDiff = Clock.diffUTCTime end start putStrLn $ "Total compilation took " ++ show startEndDiff++parsePrimitive :: Primitive Text -> Primitive BlackBoxTemplate+parsePrimitive (BlackBox pNm templT) =+ let (templ,err) = either (first Left . runParse) (first Right . runParse) templT+ in case err of+ [] -> BlackBox pNm templ+ _ -> error $ "Errors in template for: " ++ show pNm ++ ":\n" ++ show err+parsePrimitive (Primitive pNm typ) = Primitive pNm typ -- | Pretty print Components to HDL Documents createHDL :: Backend backend
src/CLaSH/Driver/TestbenchGen.hs view
@@ -1,8 +1,15 @@+{-|+ Copyright : (C) 2013-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Generate a HDL testbench for a component given a set of stimuli and a set of+ matching expected outputs+-}+ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} --- | Generate a HDL testbench for a component given a set of stimuli and a--- set of matching expected outputs module CLaSH.Driver.TestbenchGen ( genTestBench ) where@@ -25,7 +32,7 @@ import CLaSH.Netlist import CLaSH.Netlist.BlackBox (prepareBlackBox)-import CLaSH.Netlist.BlackBox.Types (Element (Err))+import CLaSH.Netlist.BlackBox.Types (BlackBoxTemplate, Element (Err)) import CLaSH.Netlist.Types as N import CLaSH.Normalize (cleanupGraph, normalize, runNormalization)@@ -38,7 +45,7 @@ -- set of matching expected outputs genTestBench :: CLaSHOpts -> Supply- -> PrimMap -- ^ Primitives+ -> PrimMap BlackBoxTemplate -- ^ Primitives -> (HashMap TyConName TyCon -> Type -> Maybe (Either String HWType)) -> HashMap TyConName TyCon -> IntMap TyConName@@ -102,11 +109,11 @@ -> TmName -> HashMap TmName (Type,Term) normalizeSignal glbls bndr =- runNormalization opts supply glbls typeTrans tcm tupTcm eval (normalize [bndr] >>= cleanupGraph bndr)+ runNormalization opts supply glbls typeTrans tcm tupTcm eval primMap (normalize [bndr] >>= cleanupGraph bndr) genTestBench opts _ _ _ _ _ _ _ _ _ _ _ dfiles c = traceIf (opt_dbgLevel opts > DebugNone) ("Can't make testbench for: " ++ show c) $ return ([],dfiles) -genClock :: PrimMap+genClock :: PrimMap BlackBoxTemplate -> (Identifier,HWType) -> NetlistMonad (Maybe [Declaration]) genClock primMap (clkName,Clock clkSym rate) =@@ -131,7 +138,7 @@ genClock _ _ = return Nothing -genReset :: PrimMap+genReset :: PrimMap BlackBoxTemplate -> (Identifier,HWType) -> NetlistMonad (Maybe [Declaration]) genReset primMap (rstName,Reset clkSym rate) =@@ -152,7 +159,7 @@ genReset _ _ = return Nothing -genFinish :: PrimMap+genFinish :: PrimMap BlackBoxTemplate -> NetlistMonad Declaration genFinish primMap = case HashMap.lookup "CLaSH.Driver.TestbenchGen.finishedGen" primMap of Just (BlackBox _ (Left templ)) -> do@@ -164,7 +171,7 @@ return $ BlackBoxD "CLaSH.Driver.TestbenchGen.finishGen" templ' ctx pM -> error $ $(curLoc) ++ ("Can't make finish declaration for: " ++ show pM) -genDone :: PrimMap+genDone :: PrimMap BlackBoxTemplate -> NetlistMonad Declaration genDone primMap = case HashMap.lookup "CLaSH.Driver.TestbenchGen.doneGen" primMap of Just (BlackBox _ (Left templ)) -> do@@ -177,7 +184,7 @@ pM -> error $ $(curLoc) ++ ("Can't make done declaration for: " ++ show pM) genStimuli :: Int- -> PrimMap+ -> PrimMap BlackBoxTemplate -> HashMap TmName (Type,Term) -> (HashMap TyConName TyCon -> Type -> Maybe (Either String HWType)) -> HashMap TyConName TyCon@@ -213,7 +220,7 @@ return (decl,comps,cmpCnt',hidden'',dfiles') genVerifier :: Int- -> PrimMap+ -> PrimMap BlackBoxTemplate -> HashMap TmName (Type,Term) -> (HashMap TyConName TyCon -> Type -> Maybe (Either String HWType)) -> HashMap TyConName TyCon
src/CLaSH/Driver/TopWrapper.hs view
@@ -1,3 +1,9 @@+{-|+ Copyright : (C) 2015-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-}+ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-}@@ -5,11 +11,6 @@ {-# OPTIONS_HADDOCK show-extensions #-} -{-|-Copyright : (C) 2015, University of Twente-License : BSD2 (see the file LICENSE)-Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>--} module CLaSH.Driver.TopWrapper where import Data.Char (isDigit)@@ -23,6 +24,7 @@ import CLaSH.Netlist (runNetlistMonad) import CLaSH.Netlist.BlackBox (prepareBlackBox)+import CLaSH.Netlist.BlackBox.Types (BlackBoxTemplate) import CLaSH.Netlist.Types (BlackBoxContext (..), Component (..), Declaration (..), Expr (..), Identifier, HWType (..), Modifier (..), NetlistMonad,@@ -31,7 +33,7 @@ import CLaSH.Util -- | Create a wrapper around a component, potentially initiating clock sources-mkTopWrapper :: PrimMap+mkTopWrapper :: PrimMap BlackBoxTemplate -> Maybe TopEntity -- ^ TopEntity specifications -> String -- ^ Name of the module containing the @topEntity@ -> Int -- ^ Int/Word/Integer bit-width@@ -204,7 +206,7 @@ iName = append i (pack ("_" ++ show cnt)) -- | Create clock generators-mkClocks :: PrimMap -> [(Identifier,HWType)] -> Int -> Maybe TopEntity -> [Declaration]+mkClocks :: PrimMap BlackBoxTemplate -> [(Identifier,HWType)] -> Int -> Maybe TopEntity -> [Declaration] mkClocks primMap hidden iw teM = concat [ clockGens , resets@@ -249,7 +251,7 @@ clks = map snd outp -- | Generate resets-mkResets :: PrimMap+mkResets :: PrimMap BlackBoxTemplate -> [(Identifier,HWType)] -> Int -> [(Identifier,[String],Bool)]@@ -269,7 +271,7 @@ -- | Generate a reset synchroniser that synchronously de-asserts an -- asynchronous reset signal-genSyncReset :: PrimMap+genSyncReset :: PrimMap BlackBoxTemplate -> Identifier -> Identifier -> Text
src/CLaSH/Driver/Types.hs view
@@ -1,4 +1,11 @@--- | Type definitions used by the Driver module+{-|+ Copyright : (C) 2013-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Type definitions used by the Driver module+-}+ module CLaSH.Driver.Types where import Data.HashMap.Lazy (HashMap)
src/CLaSH/Netlist.hs view
@@ -1,7 +1,14 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Create Netlists out of normalized CoreHW Terms+-}+ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} --- | Create Netlists out of normalized CoreHW Terms module CLaSH.Netlist where import Control.Lens ((.=), (<<%=))@@ -31,6 +38,7 @@ import CLaSH.Core.Util (collectArgs, isVar, termType) import CLaSH.Core.Var (Id, Var (..)) import CLaSH.Netlist.BlackBox+import CLaSH.Netlist.BlackBox.Types (BlackBoxTemplate) import CLaSH.Netlist.Id import CLaSH.Netlist.Types as HW import CLaSH.Netlist.Util@@ -44,7 +52,7 @@ -- ^ Starting number of the component counter -> HashMap TmName (Type,Term) -- ^ Global binders- -> PrimMap+ -> PrimMap BlackBoxTemplate -- ^ Primitive definitions -> HashMap TyConName TyCon -- ^ TyCon cache@@ -70,7 +78,7 @@ -- ^ Starting number of the component counter -> HashMap TmName (Type,Term) -- ^ Global binders- -> PrimMap+ -> PrimMap BlackBoxTemplate -- ^ Primitive Definitions -> HashMap TyConName TyCon -- ^ TyCon cache
src/CLaSH/Netlist.hs-boot view
@@ -1,3 +1,9 @@+{-|+ Copyright : (C) 2015-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-}+ module CLaSH.Netlist (genComponent,mkExpr,mkDcApplication) where import CLaSH.Core.DataCon (DataCon)
src/CLaSH/Netlist/BlackBox.hs view
@@ -1,8 +1,15 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Functions to create BlackBox Contexts and fill in BlackBox templates+-}+ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} --- | Functions to create BlackBox Contexts and fill in BlackBox templates module CLaSH.Netlist.BlackBox where import Control.Lens ((.=),(<<%=))@@ -12,7 +19,7 @@ import Data.Either (lefts) import qualified Data.HashMap.Lazy as HashMap import qualified Data.IntMap as IntMap-import Data.Text.Lazy (Text, fromStrict, pack)+import Data.Text.Lazy (fromStrict, pack) import qualified Data.Text.Lazy as Text import Data.Text (unpack) import qualified Data.Text as TextS@@ -31,7 +38,6 @@ import CLaSH.Core.Var as V (Id, Var (..)) import {-# SOURCE #-} CLaSH.Netlist (genComponent, mkDcApplication, mkExpr)-import CLaSH.Netlist.BlackBox.Parser as B import CLaSH.Netlist.BlackBox.Types as B import CLaSH.Netlist.BlackBox.Util as B import CLaSH.Netlist.Id as N@@ -70,20 +76,18 @@ else return (im,[]) prepareBlackBox :: TextS.Text- -> Text+ -> BlackBoxTemplate -> BlackBoxContext -> NetlistMonad BlackBoxTemplate-prepareBlackBox pNm t bbCtx =- let (templ,err) = runParse t- in if null err && verifyBlackBoxContext bbCtx templ- then instantiateSym >=>- setClocks bbCtx >=>- collectFilePaths bbCtx >=>- instantiateCompName $ templ- else- error $ $(curLoc) ++ "\nCan't match template for " ++ show pNm ++ " :\n" ++ show t ++- "\nwith context:\n" ++ show bbCtx ++ "\ngiven errors:\n" ++- show err+prepareBlackBox pNm templ bbCtx =+ if verifyBlackBoxContext bbCtx templ+ then instantiateSym >=>+ setClocks bbCtx >=>+ collectFilePaths bbCtx >=>+ instantiateCompName $ templ+ else+ error $ $(curLoc) ++ "\nCan't match template for " ++ show pNm ++ " :\n" ++ show templ +++ "\nwith context:\n" ++ show bbCtx mkArgument :: Term -> NetlistMonad ( (SyncExpr,HWType,Bool)@@ -255,17 +259,17 @@ Nothing -> error $ $(curLoc) ++ "Cannot make function input for: " ++ showDoc e _ -> error $ $(curLoc) ++ "Cannot make function input for: " ++ showDoc e case templ of- Left (_, Left templ') -> let (l,err) = runParse templ'- in if null err- then do- l' <- instantiateSym l- l'' <- setClocks bbCtx l'- l3 <- instantiateCompName l''- return ((Left l3,bbCtx),dcls)- else error $ $(curLoc) ++ "\nTemplate:\n" ++ show templ ++ "\nHas errors:\n" ++ show err- Left (_, Right templ') -> let ass = Assignment (pack "~RESULT") (Identifier templ' Nothing)- in return ((Right ass, bbCtx),dcls)- Right decl -> return ((Right decl,bbCtx),dcls)+ Left (_, Left templ') -> do+ l' <- instantiateSym templ'+ l'' <- setClocks bbCtx l'+ l3 <- instantiateCompName l''+ return ((Left l3,bbCtx),dcls)+ Left (_, Right templ') -> do+ templ'' <- prettyBlackBox templ'+ let ass = Assignment (pack "~RESULT") (Identifier templ'' Nothing)+ return ((Right ass, bbCtx),dcls)+ Right decl ->+ return ((Right decl,bbCtx),dcls) -- | Instantiate symbols references with a new symbol and increment symbol counter instantiateSym :: BlackBoxTemplate
src/CLaSH/Netlist/BlackBox/Parser.hs view
@@ -1,4 +1,11 @@--- | Parser definitions for BlackBox templates+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Parser definitions for BlackBox templates+-}+ module CLaSH.Netlist.BlackBox.Parser (runParse) where@@ -82,6 +89,10 @@ <|> SigD <$> (pToken "~SIGD" *> pBrackets pSigD) <*> (Just <$> (pBrackets pNatural)) <|> (`SigD` Nothing) <$> (pToken "~SIGDO" *> pBrackets pSigD) <|> IW64 <$ pToken "~IW64"+ <|> (BV True) <$> (pToken "~TOBV" *> pBrackets pSigD) <*> (Just <$> pBrackets pNatural)+ <|> (BV True) <$> (pToken "~TOBVO" *> pBrackets pSigD) <*> pure Nothing+ <|> (BV False) <$> (pToken "~FROMBV" *> pBrackets pSigD) <*> (Just <$> pBrackets pNatural)+ <|> (BV False) <$> (pToken "~FROMBVO" *> pBrackets pSigD) <*> pure Nothing -- | Parse a bracketed text pBrackets :: Parser a -> Parser a@@ -102,7 +113,9 @@ -- | Parse SigD pSigD :: Parser [Element]-pSigD = pSome (pTagE <|> pLimitedText)+pSigD = pSome (pTagE <|> pLimitedText+ <|> (C <$> (pack <$> pToken "[ "))+ <|> (C <$> (pack <$> pToken " ]"))) -- | Text excluding square brackets and tilde pLimitedText :: Parser Element
src/CLaSH/Netlist/BlackBox/Types.hs view
@@ -1,4 +1,11 @@--- | Types used in BlackBox modules+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Types used in BlackBox modules+-}+ module CLaSH.Netlist.BlackBox.Types where import Data.Text.Lazy (Text)@@ -32,6 +39,7 @@ | IF !Element [Element] [Element] | IW64 -- ^ Hole indicating whether Int/Word/Integer -- are 64-Bit+ | BV Bool [Element] (Maybe Int) -- ^ Convert to (True)/from(False) a bit-vector | SigD [Element] !(Maybe Int) deriving Show
src/CLaSH/Netlist/BlackBox/Util.hs view
@@ -1,11 +1,18 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Utilties to verify blackbox contexts against templates and rendering filled+ in templates+-}+ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} --- | Utilties to verify blackbox contexts against templates and rendering--- filled in templates module CLaSH.Netlist.BlackBox.Util where import Control.Lens (at, use, (%=), (+=), _1,@@ -14,7 +21,7 @@ import Control.Monad.Writer.Strict (MonadWriter, tell) import Data.Foldable (foldrM) import qualified Data.IntMap as IntMap-import Data.List (mapAccumL)+import Data.List (mapAccumL, nub) import Data.Set (Set,singleton) import Data.Text.Lazy (Text) import qualified Data.Text.Lazy as Text@@ -22,7 +29,10 @@ takeBaseName, takeFileName) import Text.PrettyPrint.Leijen.Text.Monadic (displayT, renderCompact,- renderOneLine)+ renderOneLine, brackets,+ int, (<>), text, (<+>),+ vcat, (<$$>), nest)+import qualified Text.PrettyPrint.Leijen.Text.Monadic as PP import CLaSH.Backend (Backend (..)) import CLaSH.Netlist.BlackBox.Parser@@ -82,6 +92,7 @@ D (Decl n l') -> D <$> (Decl n <$> mapM (combineM setSym' setSym') l') IF c t f -> IF <$> pure c <*> setSym' t <*> setSym' f SigD e' m -> SigD <$> (setSym' e') <*> pure m+ BV t e' m -> BV <$> pure t <*> setSym' e' <*> pure m _ -> pure e ) @@ -102,6 +113,7 @@ setClocks' (D (Decl n l)) = D <$> (Decl n <$> mapM (combineM (setClocks bc) (setClocks bc)) l) setClocks' (IF c t f) = IF <$> pure c <*> setClocks bc t <*> setClocks bc f setClocks' (SigD e m) = SigD <$> (setClocks bc e) <*> pure m+ setClocks' (BV t e m) = BV <$> pure t <*> setClocks bc e <*> pure m setClocks' (Clk Nothing) = let (clk,rate) = clkSyncId $ fst $ bbResult bc clkName = Text.append clk (Text.pack (show rate))@@ -200,7 +212,7 @@ (either id fst -> Literal _ (NumLit i),_,_) -> fromInteger i _ -> error $ $(curLoc) ++ "IF: LIT must be a numeric lit" IW64 -> if iw == 64 then 1 else 0- _ -> error $ $(curLoc) ++ "IF: condition must be: SIZE, LENGHT, IW64, or LIT"+ _ -> error $ $(curLoc) ++ "IF: condition must be: SIZE, LENGTH, IW64, or LIT" if c' > 0 then renderBlackBox t b else renderBlackBox f b renderElem b e = renderTag b e@@ -261,6 +273,24 @@ mkLit i = i renderTag _ (Sym n) = return $ Text.pack ("n_" ++ show n)++renderTag b (BV True es (Just n)) = do+ e' <- Text.concat <$> mapM (renderElem b) es+ let (_,hty,_) = bbInputs b !! n+ (displayT . renderOneLine) <$> toBV hty e'+renderTag b (BV True es Nothing) = do+ e' <- Text.concat <$> mapM (renderElem b) es+ let (_,hty) = bbResult b+ (displayT . renderOneLine) <$> toBV hty e'+renderTag b (BV False es (Just n)) = do+ e' <- Text.concat <$> mapM (renderElem b) es+ let (_,hty,_) = bbInputs b !! n+ (displayT . renderOneLine) <$> fromBV hty e'+renderTag b (BV False es Nothing) = do+ e' <- Text.concat <$> mapM (renderElem b) es+ let (_,hty) = bbResult b+ (displayT . renderOneLine) <$> fromBV hty e'+ renderTag b (Typ Nothing) = fmap (displayT . renderOneLine) . hdlType . snd $ bbResult b renderTag b (Typ (Just n)) = let (_,ty,_) = bbInputs b !! n in (displayT . renderOneLine) <$> hdlType ty@@ -287,3 +317,93 @@ renderTag _ (IndexType _) = error $ $(curLoc) ++ "Unexpected index type" renderTag _ (FilePath _) = error $ $(curLoc) ++ "Unexpected file name" renderTag _ IW64 = error $ $(curLoc) ++ "Unexpected IW64"++prettyBlackBox :: Monad m+ => BlackBoxTemplate+ -> m Text+prettyBlackBox bbT = Text.concat <$> mapM prettyElem bbT++prettyElem :: Monad m+ => Element+ -> m Text+prettyElem (C t) = return t+prettyElem (D (Decl i args)) = do+ args' <- mapM (\(a,b) -> (,) <$> prettyBlackBox a <*> prettyBlackBox b) args+ (displayT . renderOneLine) <$>+ (nest 2 (text "~INST" <+> int i <$$>+ text "~OUTPUT" <+> text "=>" <+> text (fst (head args')) <+> text (snd (head args')) <+> text "~" <$$>+ vcat (mapM (\(a,b) -> text "~INPUT" <+> text "=>" <+> text a <+> text b <+> text "~") (tail args')))+ PP.<$$> text "~INST")+prettyElem O = return "~RESULT"+prettyElem (I i) = (displayT . renderOneLine) <$> (text "~ARG" <> brackets (int i))+prettyElem (L i) = (displayT . renderOneLine) <$> (text "~LIT" <> brackets (int i))+prettyElem (Sym i) = (displayT . renderOneLine) <$> (text "~SYM" <> brackets (int i))+prettyElem (Clk Nothing) = return "~CLKO"+prettyElem (Clk (Just i)) = (displayT . renderOneLine) <$> (text "~CLK" <> brackets (int i))+prettyElem (Rst Nothing) = return "~RSTO"+prettyElem (Rst (Just i)) = (displayT . renderOneLine) <$> (text "~RSTO" <> brackets (int i))+prettyElem (Typ Nothing) = return "~TYPO"+prettyElem (Typ (Just i)) = (displayT . renderOneLine) <$> (text "~TYPO" <> brackets (int i))+prettyElem (TypM Nothing) = return "~TYPMO"+prettyElem (TypM (Just i)) = (displayT . renderOneLine) <$> (text "~TYPM" <> brackets (int i))+prettyElem (Err Nothing) = return "~ERRORO"+prettyElem (Err (Just i)) = (displayT . renderOneLine) <$> (text "~ERROR" <> brackets (int i))+prettyElem (TypElem e) = do+ e' <- prettyElem e+ (displayT . renderOneLine) <$> (text "~TYPEL" <> brackets (text e'))+prettyElem CompName = return "~COMPNAME"+prettyElem (IndexType e) = do+ e' <- prettyElem e+ (displayT . renderOneLine) <$> (text "~INDEXTYPE" <> brackets (text e'))+prettyElem (Size e) = do+ e' <- prettyElem e+ (displayT . renderOneLine) <$> (text "~SIZE" <> brackets (text e'))+prettyElem (Length e) = do+ e' <- prettyElem e+ (displayT . renderOneLine) <$> (text "~LENGTH" <> brackets (text e'))+prettyElem (FilePath e) = do+ e' <- prettyElem e+ (displayT . renderOneLine) <$> (text "~FILE" <> brackets (text e'))+prettyElem (Gen b) = if b then return "~GENERATE" else return "~ENDGENERATE"+prettyElem (IF b esT esF) = do+ b' <- prettyElem b+ esT' <- prettyBlackBox esT+ esF' <- prettyBlackBox esF+ (displayT . renderCompact) <$>+ (text "~IF" <+> text b' <+> text "~THEN" PP.<$>+ text esT' PP.<$>+ text "~ELSE" PP.<$>+ text esF' PP.<$>+ text "~FI")+prettyElem IW64 = return "~IW64"+prettyElem (BV b es mI) = do+ es' <- prettyBlackBox es+ (displayT . renderOneLine) <$>+ if b+ then maybe (text "~TOBVO" <> brackets (text es'))+ (((text "~TOBV" <> brackets (text es')) <>) . int)+ mI+ else maybe (text "~FROMBVO" <> brackets (text es'))+ (((text "~FROMBV" <> brackets (text es')) <>) . int)+ mI+prettyElem (SigD es mI) = do+ es' <- prettyBlackBox es+ (displayT . renderOneLine) <$>+ (maybe (text "~SIGDO" <> brackets (text es'))+ (((text "~SIGD" <> brackets (text es')) <>) . int)+ mI)++usedArguments :: BlackBoxTemplate+ -> [Int]+usedArguments = nub . concatMap go+ where+ go x = case x of+ D (Decl i args) -> i : concatMap (\(a,b) -> usedArguments a ++ usedArguments b) args+ I i -> [i]+ L i -> [i]+ IndexType e -> go e+ FilePath e -> go e+ IF b esT esF -> go b ++ usedArguments esT ++ usedArguments esF+ SigD es _ -> usedArguments es+ BV _ es _ -> usedArguments es+ _ -> []
src/CLaSH/Netlist/Id.hs view
@@ -1,7 +1,15 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Transform/format a Netlist Identifier so that it is acceptable as a HDL identifier+-}+ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-}--- | Transform/format a Netlist Identifier so that it is acceptable as a HDL identifier+ module CLaSH.Netlist.Id ( mkBasicId , mkBasicId'
src/CLaSH/Netlist/Types.hs view
@@ -1,8 +1,15 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Type and instance definitions for Netlist modules+-}+ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} --- | Type and instance definitions for Netlist modules module CLaSH.Netlist.Types where import Control.DeepSeq@@ -44,7 +51,7 @@ , _varCount :: !Int -- ^ Number of signal declarations , _cmpCount :: !Int -- ^ Number of create components , _components :: HashMap TmName Component -- ^ Cached components- , _primitives :: PrimMap -- ^ Primitive Definitions+ , _primitives :: PrimMap BlackBoxTemplate -- ^ Primitive Definitions , _typeTranslator :: HashMap TyConName TyCon -> Type -> Maybe (Either String HWType) -- ^ Hardcoded Type -> HWType translator , _tcCache :: HashMap TyConName TyCon -- ^ TyCon cache , _modNm :: !String -- ^ Name of the module containing the @topEntity@
src/CLaSH/Netlist/Util.hs view
@@ -1,7 +1,14 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Utilities for converting Core Type/Term to Netlist datatypes+-}+ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} --- | Utilities for converting Core Type/Term to Netlist datatypes module CLaSH.Netlist.Util where import Control.Error (hush)
src/CLaSH/Normalize.hs view
@@ -1,6 +1,13 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Turn CoreHW terms into normalized CoreHW Terms+-}+ {-# LANGUAGE TemplateHaskell #-} --- | Turn CoreHW terms into normalized CoreHW Terms module CLaSH.Normalize where import Control.Concurrent.Supply (Supply)@@ -21,11 +28,12 @@ import CLaSH.Core.Pretty (showDoc) import CLaSH.Core.Subst (substTms) import CLaSH.Core.Term (Term (..), TmName)-import CLaSH.Core.Type (Type, splitFunForallTy)+import CLaSH.Core.Type (Type, splitCoreFunForallTy) import CLaSH.Core.TyCon (TyCon, TyConName) import CLaSH.Core.Util (collectArgs, mkApps, termType) import CLaSH.Core.Var (Id,varName) import CLaSH.Driver.Types (CLaSHOpts (..))+import CLaSH.Netlist.BlackBox.Types (BlackBoxTemplate) import CLaSH.Netlist.Types (HWType) import CLaSH.Netlist.Util (splitNormalized) import CLaSH.Normalize.Strategy@@ -33,6 +41,7 @@ reduceConst, topLet ) import CLaSH.Normalize.Types import CLaSH.Normalize.Util+import CLaSH.Primitives.Types (PrimMap) import CLaSH.Rewrite.Combinators ((>->),(!->),repeatR,topdownR) import CLaSH.Rewrite.Types (DebugLevel (..), RewriteEnv (..), RewriteState (..), bindings, curFun, dbgLevel,@@ -57,10 +66,12 @@ -- ^ Tuple TyCon cache -> (HashMap TyConName TyCon -> Bool -> Term -> Term) -- ^ Hardcoded evaluator (delta-reduction)+ -> PrimMap BlackBoxTemplate+ -- ^ Primitive Definitions -> NormalizeSession a -- ^ NormalizeSession to run -> a-runNormalization opts supply globals typeTrans tcm tupTcm eval+runNormalization opts supply globals typeTrans tcm tupTcm eval primMap = runRewriteSession rwEnv rwState where rwEnv = RewriteEnv@@ -86,6 +97,7 @@ HashMap.empty (opt_inlineLimit opts) (opt_inlineBelow opts)+ primMap normalize :: [TmName]@@ -103,14 +115,14 @@ let nmS = showDoc nm case exprM of Just (ty,tm) -> do- let (_,resTy) = splitFunForallTy ty+ tcm <- Lens.view tcCache+ let (_,resTy) = splitCoreFunForallTy tcm ty resTyRep <- not <$> isUntranslatableType resTy if resTyRep then do tmNorm <- makeCached nm (extra.normalized) $ do curFun .= nm tm' <- rewriteExpr ("normalization",normalization) (nmS,tm)- tcm <- Lens.view tcCache ty' <- termType tcm tm' return (ty',tm') let usedBndrs = Lens.toListOf termFreeIds (snd tmNorm)
src/CLaSH/Normalize/DEC.hs view
@@ -1,3 +1,31 @@+{-|+ Copyright : (C) 2015-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Helper functions for the 'disjointExpressionConsolidation' transformation++ The 'disjointExpressionConsolidation' transformation lifts applications of+ global binders out of alternatives of case-statements.++ e.g. It converts:++ > case x of+ > A -> f 3 y+ > B -> f x x+ > C -> h x++ into:++ > 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+-}+ {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-}@@ -6,31 +34,6 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} --- | Helper functions for the 'disjointExpressionConsolidation' transformation------ The 'disjointExpressionConsolidation' transformation lifts applications of--- global binders out of alternatives of case-statements.------ e.g. It converts:------ @--- case x of--- A -> f 3 y--- B -> f x x--- C -> h x--- @------ into:------ @--- 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--- @ module CLaSH.Normalize.DEC (collectGlobals ,isDisjoint
src/CLaSH/Normalize/PrimitiveReductions.hs view
@@ -1,26 +1,33 @@+{-|+ Copyright : (C) 2015-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Reductions of primitives++ Currently, it contains reductions for:++ * CLaSH.Sized.Vector.map+ * CLaSH.Sized.Vector.zipWith+ * CLaSH.Sized.Vector.traverse#+ * CLaSH.Sized.Vector.foldr+ * CLaSH.Sized.Vector.fold+ * CLaSH.Sized.Vector.dfold+ * CLaSH.Sized.Vector.(++)+ * CLaSH.Sized.Vector.head+ * CLaSH.Sized.Vector.tail+ * CLaSH.Sized.Vector.unconcatBitVector#+ * CLaSH.Sized.Vector.replicate++ Partially handles:++ * CLaSH.Sized.Vector.unconcat+ * CLaSH.Sized.Vector.transpose+-}+ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} --- | Reductions of primitives------ Currently, it contains reductions for:------ * CLaSH.Sized.Vector.map--- * CLaSH.Sized.Vector.zipWith--- * CLaSH.Sized.Vector.traverse#--- * CLaSH.Sized.Vector.foldr--- * CLaSH.Sized.Vector.fold--- * CLaSH.Sized.Vector.dfold--- * CLaSH.Sized.Vector.(++)--- * CLaSH.Sized.Vector.head--- * CLaSH.Sized.Vector.tail--- * CLaSH.Sized.Vector.unconcatBitVector#--- * CLaSH.Sized.Vector.replicate------ Partially handles:------ * CLaSH.Sized.Vector.unconcat--- * CLaSH.Sized.Vector.transpose module CLaSH.Normalize.PrimitiveReductions where import qualified Control.Lens as Lens
src/CLaSH/Normalize/Strategy.hs view
@@ -1,4 +1,11 @@--- | Transformation process for normalization+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Transformation process for normalization+-}+ module CLaSH.Normalize.Strategy where import CLaSH.Normalize.Transformations@@ -9,13 +16,14 @@ -- | Normalisation transformation normalization :: NormRewrite-normalization = etaTL >-> constantPropgation >-!-> anf >-!-> rmDeadcode >->+normalization = etaTL >-> constantPropgation >-> rmUnusedExpr >-!-> anf >-!-> rmDeadcode >-> bindConst >-> letTL >-> evalConst >-!-> cse >-!-> recLetRec where etaTL = apply "etaTL" etaExpansionTL anf = topdownR (apply "nonRepANF" nonRepANF) >-> apply "ANF" makeANF letTL = topdownSucR (apply "topLet" topLet) recLetRec = apply "recToLetRec" recToLetRec+ rmUnusedExpr = bottomupR (apply "removeUnusedExpr" removeUnusedExpr) rmDeadcode = topdownR (apply "deadcode" deadCode) bindConst = topdownR (apply "bindConstantVar" bindConstantVar) evalConst = topdownR (apply "evalConst" reduceConst)
src/CLaSH/Normalize/Transformations.hs view
@@ -1,8 +1,15 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Transformations of the Normalization process+-}+ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} --- | Transformations of the Normalization process module CLaSH.Normalize.Transformations ( appProp , bindNonRep@@ -29,6 +36,7 @@ , reduceNonRepPrim , caseFlat , disjointExpressionConsolidation+ , removeUnusedExpr ) where @@ -41,6 +49,7 @@ import qualified Data.HashMap.Lazy as HashMap import qualified Data.List as List import qualified Data.Maybe as Maybe+import qualified Data.Set as Set import qualified Data.Set.Lens as Lens import Data.Text (Text, unpack) import Unbound.Generics.LocallyNameless (Bind, Embed (..), bind, embed,@@ -58,7 +67,7 @@ import CLaSH.Core.Type (TypeView (..), applyFunTy, applyTy, isPolyFunCoreTy, splitFunTy, typeKind,- tyView)+ tyView, undefinedTy) import CLaSH.Core.TyCon (tyConDataCons) import CLaSH.Core.Util (collectArgs, idToVar, isCon, isFun, isLet, isPolyFun, isPrim,@@ -66,12 +75,14 @@ mkLams, mkTmApps, mkVec, termSize, termType, tyNatSize) import CLaSH.Core.Var (Id, Var (..))+import CLaSH.Netlist.BlackBox.Util (usedArguments) import CLaSH.Netlist.Util (representableType, splitNormalized) import CLaSH.Normalize.DEC import CLaSH.Normalize.PrimitiveReductions import CLaSH.Normalize.Types import CLaSH.Normalize.Util+import CLaSH.Primitives.Types (Primitive (..)) import CLaSH.Rewrite.Combinators import CLaSH.Rewrite.Types import CLaSH.Rewrite.Util@@ -247,6 +258,10 @@ | nm == "Control.Exception.Base.patError" -> let e' = mkApps (Prim nm ty') [Right ty,msg] in changed e'+ (Prim nm ty',[_])+ | nm == "GHC.Err.undefined" ->+ let e' = mkApps (Prim nm ty') [Right ty]+ in changed e' _ -> traceIf (lvl > DebugNone) ("Irreducible constant as case subject: " ++ showDoc subj ++ "\nCan be reduced to: " ++ showDoc subj') (caseOneAlt e)@@ -345,6 +360,49 @@ in findUsedBndrs (used ++ explore) explore' other' deadCode _ e = return e++removeUnusedExpr :: NormRewrite+removeUnusedExpr _ e@(collectArgs -> (p@(Prim nm _),args)) = do+ bbM <- HashMap.lookup nm <$> Lens.use (extra.primitives)+ case bbM of+ Just (BlackBox pNm templ) -> do+ let usedArgs = if pNm `elem` ["CLaSH.Sized.Internal.Signed.fromInteger#"+ ,"CLaSH.Sized.Internal.Unsigned.fromInteger#"+ ,"CLaSH.Sized.Internal.BitVector.fromInteger#"+ ,"CLaSH.Sized.Internal.Index.fromInteger#"+ ]+ then [0,1]+ else either usedArguments usedArguments templ+ tcm <- Lens.view tcCache+ args' <- go tcm 0 usedArgs args+ if args == args'+ then return e+ else changed (mkApps p args')+ _ -> return e+ where+ go _ _ _ [] = return []+ go tcm n used (Right ty:args') = do+ args'' <- go tcm n used args'+ return (Right ty : args'')+ go tcm n used (Left tm : args') = do+ args'' <- go tcm (n+1) used args'+ ty <- termType tcm tm+ let p' = mkApps (Prim "CLaSH.Transformations.removedArg" undefinedTy) [Right ty]+ if n `elem` used+ then return (Left tm : args'')+ else return (Left p' : args'')++removeUnusedExpr _ e@(Case _ _ [alt]) = do+ (pat,altExpr) <- unbind alt+ case pat of+ DataPat _ (unrebind -> ([],xs)) -> do+ let altFreeIds = Lens.setOf termFreeIds altExpr+ if Set.null (Set.intersection (Set.fromList (map varName xs)) altFreeIds)+ then changed altExpr+ else return e+ _ -> return e++removeUnusedExpr _ e = return e -- | Inline let-bindings when the RHS is either a local variable reference or -- is constant
src/CLaSH/Normalize/Types.hs view
@@ -1,14 +1,24 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Types used in Normalize modules+-}+ {-# LANGUAGE TemplateHaskell #-}--- | Types used in Normalize modules+ module CLaSH.Normalize.Types where import Control.Monad.State.Strict (State) import Data.HashMap.Strict (HashMap) import Data.Map (Map) -import CLaSH.Core.Term (Term, TmName)-import CLaSH.Core.Type (Type)-import CLaSH.Rewrite.Types (Rewrite, RewriteMonad)+import CLaSH.Core.Term (Term, TmName)+import CLaSH.Core.Type (Type)+import CLaSH.Netlist.BlackBox.Types (BlackBoxTemplate)+import CLaSH.Primitives.Types (PrimMap)+import CLaSH.Rewrite.Types (Rewrite, RewriteMonad) import CLaSH.Util -- | State of the 'NormalizeMonad'@@ -37,6 +47,7 @@ , _inlineBelow :: !Int -- ^ Size of a function below which it is always inlined if it is not -- recursive+ , _primitives :: PrimMap BlackBoxTemplate -- ^ Primitive Definitions } makeLenses ''NormalizeState
src/CLaSH/Normalize/Util.hs view
@@ -1,7 +1,14 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Utility functions used by the normalisation transformations+-}+ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-} --- | Utility functions used by the normalisation transformations module CLaSH.Normalize.Util where import Control.Lens ((%=))
src/CLaSH/Primitives/Types.hs view
@@ -1,7 +1,15 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Type and instance definitions for Primitive+-}++{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} --- | Type and instance definitions for Primitive module CLaSH.Primitives.Types where import Control.Applicative ((<|>))@@ -12,14 +20,14 @@ import Data.Text.Lazy (Text) -- | Primitive Definitions-type PrimMap = HashMap S.Text Primitive+type PrimMap a = HashMap S.Text (Primitive a) -- | Externally defined primitive-data Primitive+data Primitive a -- | A primitive that has a template that can be filled out by the backend render = BlackBox { name :: !S.Text -- ^ Name of the primitive- , template :: !(Either Text Text) -- ^ Either a /declaration/ or an /expression/ template.+ , template :: !(Either a a) -- ^ Either a /declaration/ or an /expression/ template. } -- | A primitive that carries additional information | Primitive@@ -28,7 +36,7 @@ } deriving Show -instance FromJSON Primitive where+instance FromJSON (Primitive Text) where parseJSON (Object v) = case H.toList v of [(conKey,Object conVal)] -> case conKey of "BlackBox" -> BlackBox <$> conVal .: "name" <*> ((Left <$> conVal .: "templateD") <|> (Right <$> conVal .: "templateE"))
src/CLaSH/Primitives/Util.hs view
@@ -1,4 +1,11 @@--- | Utility functions to generate Primitives+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Utility functions to generate Primitives+-}+ module CLaSH.Primitives.Util where import Data.Aeson.Extra (decodeAndReport)@@ -6,6 +13,7 @@ import qualified Data.HashMap.Lazy as HashMap import Data.List (isSuffixOf) import Data.Maybe (fromMaybe)+import Data.Text.Lazy (Text) import qualified System.Directory as Directory import qualified System.FilePath as FilePath @@ -15,7 +23,7 @@ -- | Generate a set of primitives that are found in the primitive definition -- files in the given directories. generatePrimMap :: [FilePath] -- ^ Directories to search for primitive definitions- -> IO PrimMap+ -> IO (PrimMap Text) generatePrimMap filePaths = do primitiveFiles <- fmap concat $ mapM (\filePath ->
src/CLaSH/Rewrite/Combinators.hs view
@@ -1,6 +1,13 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Rewriting combinators and traversals+-}+ {-# LANGUAGE ScopedTypeVariables #-} --- | Rewriting combinators and traversals module CLaSH.Rewrite.Combinators where import Control.DeepSeq (deepseq)
src/CLaSH/Rewrite/Types.hs view
@@ -1,9 +1,16 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Type and instance definitions for Rewrite modules+-}+ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} --- | Type and instance definitions for Rewrite modules module CLaSH.Rewrite.Types where import Control.Concurrent.Supply (Supply, freshId)
src/CLaSH/Rewrite/Util.hs view
@@ -1,7 +1,14 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Utilities for rewriting: e.g. inlining, specialisation, etc.+-}+ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TemplateHaskell #-} --- | Utilities for rewriting: e.g. inlining, specialisation, etc. module CLaSH.Rewrite.Util where import Control.DeepSeq
src/CLaSH/Util.hs view
@@ -1,3 +1,11 @@+{-|+ Copyright : (C) 2012-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>++ Assortment of utility function used in the CLaSH library+-}+ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE Rank2Types #-}@@ -5,7 +13,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} --- | Assortment of utility function used in the CLaSH library module CLaSH.Util ( module CLaSH.Util , module X
src/Data/Aeson/Extra.hs view
@@ -1,3 +1,9 @@+{-|+ Copyright : (C) 2015-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-}+ module Data.Aeson.Extra where import Data.Aeson (FromJSON, Result (..), fromJSON, json)
src/Unbound/Generics/LocallyNameless/Extra.hs view
@@ -1,3 +1,9 @@+{-|+ Copyright : (C) 2015-2016, University of Twente+ License : BSD2 (see the file LICENSE)+ Maintainer : Christiaan Baaij <christiaan.baaij@gmail.com>+-}+ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}