diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ # Changelog for the [`clash-lib`](http://hackage.haskell.org/package/clash-lib) package +## 0.6.8 *January 13th 2015* +* New features: + * Support for Haskell's: `Char`, `Int8`, `Int16`, `Int32`, `Int64`, `Word`, `Word8`, `Word16`, `Word32`, `Word64`. + * Int/Word/Integer bitwidth for generated HDL is configurable using the `-clash-intwidth=N` flag, where `N` can be either 32 or 64. +* Fixes bugs: + * Cannot reduce `case error ... of ...` to `error ...` [#109](https://github.com/clash-lang/clash-compiler/issues/109) + ## 0.6.7 *December 21st 2015* * Support for `unbound-generics-0.3` * New features: diff --git a/clash-lib.cabal b/clash-lib.cabal --- a/clash-lib.cabal +++ b/clash-lib.cabal @@ -1,5 +1,5 @@ Name: clash-lib -Version: 0.6.7 +Version: 0.6.8 Synopsis: CAES Language for Synchronous Hardware - As a Library Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that diff --git a/src/CLaSH/Backend.hs b/src/CLaSH/Backend.hs --- a/src/CLaSH/Backend.hs +++ b/src/CLaSH/Backend.hs @@ -9,7 +9,7 @@ class Backend state where -- | Initial state for state monad - initBackend :: state + initBackend :: Int -> state -- | Location for the primitive definitions primDir :: state -> IO FilePath @@ -42,3 +42,5 @@ inst :: Declaration -> State state (Maybe Doc) -- | Turn a Netlist expression into a HDL expression expr :: Bool -> Expr -> State state Doc + -- | Bit-width of Int/Word/Integer + iwWidth :: State state Int diff --git a/src/CLaSH/Core/Literal.hs b/src/CLaSH/Core/Literal.hs --- a/src/CLaSH/Core/Literal.hs +++ b/src/CLaSH/Core/Literal.hs @@ -16,13 +16,21 @@ import Unbound.Generics.LocallyNameless (Alpha (..), Subst (..)) import {-# SOURCE #-} CLaSH.Core.Type (Type) -import CLaSH.Core.TysPrim (intPrimTy, stringPrimTy, voidPrimTy) +import CLaSH.Core.TysPrim (intPrimTy, integerPrimTy, + charPrimTy, stringPrimTy, + voidPrimTy, wordPrimTy, + int64PrimTy, word64PrimTy) -- | Term Literal data Literal = IntegerLiteral !Integer + | IntLiteral !Integer + | WordLiteral !Integer + | Int64Literal !Integer + | Word64Literal !Integer | StringLiteral !String | RationalLiteral !Rational + | CharLiteral !Char deriving (Eq,Ord,Show,Generic,NFData) instance Alpha Literal where @@ -35,6 +43,11 @@ -- | Determines the Type of a Literal literalType :: Literal -> Type -literalType (IntegerLiteral _) = intPrimTy -literalType (RationalLiteral _) = voidPrimTy +literalType (IntegerLiteral _) = integerPrimTy +literalType (IntLiteral _) = intPrimTy +literalType (WordLiteral _) = wordPrimTy literalType (StringLiteral _) = stringPrimTy +literalType (RationalLiteral _) = voidPrimTy +literalType (CharLiteral _) = charPrimTy +literalType (Int64Literal _) = int64PrimTy +literalType (Word64Literal _) = word64PrimTy diff --git a/src/CLaSH/Core/Pretty.hs b/src/CLaSH/Core/Pretty.hs --- a/src/CLaSH/Core/Pretty.hs +++ b/src/CLaSH/Core/Pretty.hs @@ -121,7 +121,16 @@ IntegerLiteral i | i < 0 -> return $ parens (integer i) | otherwise -> return $ integer i + IntLiteral i + | i < 0 -> return $ parens (integer i) + | otherwise -> return $ integer i + Int64Literal i + | i < 0 -> return $ parens (integer i) + | otherwise -> return $ integer i + WordLiteral w -> return $ integer w + Word64Literal w -> return $ integer w RationalLiteral r -> return $ rational r + CharLiteral c -> return $ char c StringLiteral s -> return $ vcat $ map text $ showMultiLineString s instance Pretty Pat where diff --git a/src/CLaSH/Core/TysPrim.hs b/src/CLaSH/Core/TysPrim.hs --- a/src/CLaSH/Core/TysPrim.hs +++ b/src/CLaSH/Core/TysPrim.hs @@ -4,8 +4,13 @@ , typeNatKind , typeSymbolKind , intPrimTy + , integerPrimTy + , charPrimTy , stringPrimTy , voidPrimTy + , wordPrimTy + , int64PrimTy + , word64PrimTy , tysPrimMap ) where @@ -38,25 +43,44 @@ typeSymbolKind = mkTyConTy typeSymbolKindTyConName -intPrimTyConName, stringPrimTyConName, voidPrimTyConName :: TyConName -intPrimTyConName = string2Name "Int" -stringPrimTyConName = string2Name "String" -voidPrimTyConName = string2Name "VOID" +intPrimTyConName, integerPrimTyConName, charPrimTyConName, stringPrimTyConName, + voidPrimTyConName, wordPrimTyConName, int64PrimTyConName, + word64PrimTyConName :: TyConName +intPrimTyConName = string2Name "GHC.Prim.Int#" +integerPrimTyConName = string2Name "GHC.Integer.Type.Integer" +stringPrimTyConName = string2Name "String" +charPrimTyConName = string2Name "GHC.Prim.Char#" +voidPrimTyConName = string2Name "VOID" +wordPrimTyConName = string2Name "GHC.Prim.Word#" +int64PrimTyConName = string2Name "GHC.Prim.Int64#" +word64PrimTyConName = string2Name "GHC.Prim.Word64#" liftedPrimTC :: TyConName -> TyCon liftedPrimTC name = PrimTyCon name liftedTypeKind 0 -- | Builtin Type -intPrimTc, stringPrimTc, voidPrimTc :: TyCon -intPrimTc = (liftedPrimTC intPrimTyConName ) -stringPrimTc = (liftedPrimTC stringPrimTyConName) -voidPrimTc = (liftedPrimTC voidPrimTyConName) +intPrimTc, integerPrimTc, charPrimTc, stringPrimTc, voidPrimTc, wordPrimTc, + int64PrimTc, word64PrimTc :: TyCon +intPrimTc = liftedPrimTC intPrimTyConName +integerPrimTc = liftedPrimTC integerPrimTyConName +charPrimTc = liftedPrimTC charPrimTyConName +stringPrimTc = liftedPrimTC stringPrimTyConName +voidPrimTc = liftedPrimTC voidPrimTyConName +wordPrimTc = liftedPrimTC wordPrimTyConName +int64PrimTc = liftedPrimTC int64PrimTyConName +word64PrimTc = liftedPrimTC word64PrimTyConName -intPrimTy, stringPrimTy, voidPrimTy :: Type -intPrimTy = mkTyConTy intPrimTyConName -stringPrimTy = mkTyConTy stringPrimTyConName -voidPrimTy = mkTyConTy voidPrimTyConName +intPrimTy, integerPrimTy, charPrimTy, stringPrimTy, voidPrimTy, wordPrimTy, + int64PrimTy, word64PrimTy :: Type +intPrimTy = mkTyConTy intPrimTyConName +integerPrimTy = mkTyConTy integerPrimTyConName +charPrimTy = mkTyConTy charPrimTyConName +stringPrimTy = mkTyConTy stringPrimTyConName +voidPrimTy = mkTyConTy voidPrimTyConName +wordPrimTy = mkTyConTy wordPrimTyConName +int64PrimTy = mkTyConTy int64PrimTyConName +word64PrimTy = mkTyConTy word64PrimTyConName tysPrimMap :: HashMap TyConName TyCon tysPrimMap = HashMap.fromList @@ -65,6 +89,11 @@ , (typeNatKindTyConName,typeNatKindtc) , (typeSymbolKindTyConName,typeSymbolKindtc) , (intPrimTyConName,intPrimTc) + , (integerPrimTyConName,integerPrimTc) + , (charPrimTyConName,charPrimTc) , (stringPrimTyConName,stringPrimTc) , (voidPrimTyConName,voidPrimTc) + , (wordPrimTyConName,wordPrimTc) + , (int64PrimTyConName,int64PrimTc) + , (word64PrimTyConName,word64PrimTc) ] diff --git a/src/CLaSH/Core/Util.hs b/src/CLaSH/Core/Util.hs --- a/src/CLaSH/Core/Util.hs +++ b/src/CLaSH/Core/Util.hs @@ -5,6 +5,8 @@ -- | Smart constructor and destructor functions for CoreHW module CLaSH.Core.Util where +import Control.Monad.Trans.Except (Except, throwE) +import qualified Data.HashMap.Strict as HMS import qualified Data.HashMap.Lazy as HashMap import Data.HashMap.Lazy (HashMap) import qualified Data.HashSet as HashSet @@ -22,9 +24,11 @@ TmName) import CLaSH.Core.Type (Kind, LitTy (..), TyName, Type (..), TypeView (..), applyTy, - isFunTy, isPolyFunCoreTy, mkFunTy, + findFunSubst, isFunTy, + isPolyFunCoreTy, mkFunTy, splitFunTy, tyView) -import CLaSH.Core.TyCon (TyCon, TyConName, tyConDataCons) +import CLaSH.Core.TyCon (TyCon (..), TyConName, + tyConDataCons) import CLaSH.Core.TysPrim (typeNatKind) import CLaSH.Core.Var (Id, TyVar, Var (..), varType) import CLaSH.Util @@ -343,3 +347,36 @@ ++ " not found.") False go _ _ = False + +tyNatSize :: HMS.HashMap TyConName TyCon + -> Type + -> Except String Int +tyNatSize _ (LitTy (NumTy i)) = return i +tyNatSize m ty@(tyView -> TyConApp tc [ty1,ty2]) = case name2String tc of + "GHC.TypeLits.+" -> (+) <$> tyNatSize m ty1 <*> tyNatSize m ty2 + "GHC.TypeLits.*" -> (*) <$> tyNatSize m ty1 <*> tyNatSize m ty2 + "GHC.TypeLits.^" -> (^) <$> tyNatSize m ty1 <*> tyNatSize m ty2 + "GHC.TypeLits.-" -> (-) <$> tyNatSize m ty1 <*> tyNatSize m ty2 + "CLaSH.Promoted.Ord.Max" -> max <$> tyNatSize m ty1 <*> tyNatSize m ty2 + "CLaSH.Promoted.Ord.Min" -> min <$> tyNatSize m ty1 <*> tyNatSize m ty2 + "GHC.TypeLits.Extra.CLog" -> do + i1' <- tyNatSize m ty1 + i2' <- tyNatSize m ty2 + if (i1' > 1 && i2' > 0) + then return (ceiling (logBase (fromIntegral i1' :: Double) + (fromIntegral i2' :: Double))) + else throwE $ $(curLoc) ++ "Can't convert: " ++ show ty + "GHC.TypeLits.Extra.GCD" -> gcd <$> tyNatSize m ty1 <*> tyNatSize m ty2 + _ -> throwE $ $(curLoc) ++ "Can't convert tyNatOp: " ++ show tc +-- TODO: Remove this conversion +-- The current problem is that type-functions are not reduced by the GHC -> Core +-- transformation process, and so end up here. Once a fix has been found for +-- this problem remove this dirty hack. +tyNatSize tcm ty@(tyView -> TyConApp tc tys) = do + case tcm HMS.! tc of + FunTyCon {tyConSubst = tcSubst} -> case findFunSubst tcSubst tys of + Just ty' -> tyNatSize tcm ty' + _ -> throwE $ $(curLoc) ++ "Can't convert tyNat: " ++ show ty + _ -> throwE $ $(curLoc) ++ "Can't convert tyNat: " ++ show ty + +tyNatSize _ t = throwE $ $(curLoc) ++ "Can't convert tyNat: " ++ show t diff --git a/src/CLaSH/Driver.hs b/src/CLaSH/Driver.hs --- a/src/CLaSH/Driver.hs +++ b/src/CLaSH/Driver.hs @@ -69,8 +69,9 @@ putStrLn $ "Normalisation took " ++ show prepNormDiff let modName = takeWhile (/= '.') (name2String topEntity) + iw = opt_intWidth opts (netlist,dfiles,cmpCnt) <- genNetlist Nothing transformedBindings primMap tcm - typeTrans Nothing modName [] topEntity + typeTrans Nothing modName [] iw topEntity netlistTime <- netlist `deepseq` Clock.getCurrentTime let normNetDiff = Clock.diffUTCTime netlistTime normTime @@ -95,8 +96,8 @@ let netTBDiff = Clock.diffUTCTime testBenchTime netlistTime putStrLn $ "Testbench generation took " ++ show netTBDiff - let hdlState' = fromMaybe (initBackend :: backend) hdlState - topWrapper = mkTopWrapper primMap annM modName topComponent + let hdlState' = fromMaybe (initBackend iw :: backend) hdlState + topWrapper = mkTopWrapper primMap annM modName iw topComponent hdlDocs = createHDL hdlState' modName (topWrapper : netlist ++ testBench) dir = concat [ "./" ++ CLaSH.Backend.name hdlState' ++ "/" , takeWhile (/= '.') (name2String topEntity) diff --git a/src/CLaSH/Driver/TestbenchGen.hs b/src/CLaSH/Driver/TestbenchGen.hs --- a/src/CLaSH/Driver/TestbenchGen.hs +++ b/src/CLaSH/Driver/TestbenchGen.hs @@ -53,15 +53,16 @@ -> IO ([Component],[(String,FilePath)]) genTestBench opts supply primMap typeTrans tcm tupTcm eval cmpCnt globals stimuliNmM expectedNmM modName dfiles (Component cName hidden [inp] [outp] _) = do - let ioDecl = [ uncurry NetDecl inp + let iw = opt_intWidth opts + ioDecl = [ uncurry NetDecl inp , uncurry NetDecl outp ] inpExpr = Assignment (fst inp) (BlackBoxE "" [Err Nothing] (emptyBBContext {bbResult = (undefined,snd inp)}) False) (inpInst,inpComps,cmpCnt',hidden',dfiles') <- maybe (return (inpExpr,[],cmpCnt,hidden,dfiles)) - (genStimuli cmpCnt primMap globals typeTrans tcm normalizeSignal hidden inp modName dfiles) + (genStimuli cmpCnt primMap globals typeTrans tcm normalizeSignal hidden inp modName dfiles iw) stimuliNmM - ((finDecl,finExpr),s) <- runNetlistMonad (Just cmpCnt') globals primMap tcm typeTrans modName dfiles' $ do + ((finDecl,finExpr),s) <- runNetlistMonad (Just cmpCnt') globals primMap tcm typeTrans modName dfiles' iw $ do done <- genDone primMap let finDecl' = [ NetDecl "finished" Bool , done @@ -70,13 +71,13 @@ return (finDecl',finExpr') (expInst,expComps,cmpCnt'',hidden'',dfiles'') <- maybe (return (finExpr,[],cmpCnt',hidden',dfiles')) - (genVerifier cmpCnt' primMap globals typeTrans tcm normalizeSignal hidden' outp modName dfiles') + (genVerifier cmpCnt' primMap globals typeTrans tcm normalizeSignal hidden' outp modName dfiles' iw) expectedNmM let clkNms = mapMaybe (\hd -> case hd of (clkNm,Clock _ _) -> Just clkNm ; _ -> Nothing) hidden rstNms = mapMaybe (\hd -> case hd of (clkNm,Reset _ _) -> Just clkNm ; _ -> Nothing) hidden - ((clks,rsts),_) <- runNetlistMonad (Just cmpCnt'') globals primMap tcm typeTrans modName dfiles'' $ do + ((clks,rsts),_) <- runNetlistMonad (Just cmpCnt'') globals primMap tcm typeTrans modName dfiles'' iw $ do varCount .= (_varCount s) clks' <- catMaybes <$> mapM (genClock primMap) hidden'' rsts' <- catMaybes <$> mapM (genReset primMap) hidden'' @@ -115,9 +116,9 @@ falling = rising + rest ctx = emptyBBContext { bbResult = (Left (Identifier clkName Nothing), Clock clkSym rate) - , bbInputs = [ (Left (N.Literal Nothing (NumLit 3)),Integer,True) - , (Left (N.Literal Nothing (NumLit rising)),Integer,True) - , (Left (N.Literal Nothing (NumLit falling)),Integer,True) + , bbInputs = [ (Left (N.Literal Nothing (NumLit 3)),Signed 32,True) + , (Left (N.Literal Nothing (NumLit rising)),Signed 32,True) + , (Left (N.Literal Nothing (NumLit falling)),Signed 32,True) ] } templ' <- prepareBlackBox "CLaSH.Driver.TestbenchGen.clockGen" templ ctx @@ -138,7 +139,7 @@ Just (BlackBox _ (Left templ)) -> do let ctx = emptyBBContext { bbResult = (Left (Identifier rstName Nothing), Reset clkSym rate) - , bbInputs = [(Left (N.Literal Nothing (NumLit 2)),Integer,True)] + , bbInputs = [(Left (N.Literal Nothing (NumLit 2)),Signed 32,True)] } templ' <- prepareBlackBox "CLaSH.Driver.TestbenchGen.resetGen" templ ctx let resetGenDecl = BlackBoxD "CLaSH.Driver.TestbenchGen.resetGen" templ' ctx @@ -157,7 +158,7 @@ Just (BlackBox _ (Left templ)) -> do let ctx = emptyBBContext { bbResult = (Left (Identifier "finished" Nothing), Bool) - , bbInputs = [ (Left (N.Literal Nothing (NumLit 100)),Integer,True) ] + , bbInputs = [ (Left (N.Literal Nothing (NumLit 100)),Signed 32,True) ] } templ' <- prepareBlackBox "CLaSH.Driver.TestbenchGen.finishGen" templ ctx return $ BlackBoxD "CLaSH.Driver.TestbenchGen.finishGen" templ' ctx @@ -187,11 +188,12 @@ -> (Identifier,HWType) -> String -> [(String,FilePath)] + -> Int -> TmName -> IO (Declaration,[Component],Int,[(Identifier,HWType)],[(String,FilePath)]) -genStimuli cmpCnt primMap globals typeTrans tcm normalizeSignal hidden inp modName dfiles signalNm = do +genStimuli cmpCnt primMap globals typeTrans tcm normalizeSignal hidden inp modName dfiles iw signalNm = do let stimNormal = normalizeSignal globals signalNm - (comps,dfiles',cmpCnt') <- genNetlist (Just cmpCnt) stimNormal primMap tcm typeTrans Nothing modName dfiles signalNm + (comps,dfiles',cmpCnt') <- genNetlist (Just cmpCnt) stimNormal primMap tcm typeTrans Nothing modName dfiles iw signalNm let sigNm = pack (modName ++ "_") `append` last (splitOn (pack ".") (pack (name2String signalNm))) `append` pack "_" `append` (pack (show cmpCnt)) sigComp = case find ((== sigNm) . componentName) comps of Just c -> c @@ -222,11 +224,12 @@ -> (Identifier,HWType) -> String -> [(String,FilePath)] + -> Int -> TmName -> IO (Declaration,[Component],Int,[(Identifier,HWType)],[(String,FilePath)]) -genVerifier cmpCnt primMap globals typeTrans tcm normalizeSignal hidden outp modName dfiles signalNm = do +genVerifier cmpCnt primMap globals typeTrans tcm normalizeSignal hidden outp modName dfiles iw signalNm = do let stimNormal = normalizeSignal globals signalNm - (comps,dfiles',cmpCnt') <- genNetlist (Just cmpCnt) stimNormal primMap tcm typeTrans Nothing modName dfiles signalNm + (comps,dfiles',cmpCnt') <- genNetlist (Just cmpCnt) stimNormal primMap tcm typeTrans Nothing modName dfiles iw signalNm let sigNm = pack (modName ++ "_") `append` last (splitOn (pack ".") (pack (name2String signalNm))) `append` "_" `append` (pack (show cmpCnt)) sigComp = case find ((== sigNm) . componentName) comps of Just c -> c diff --git a/src/CLaSH/Driver/TopWrapper.hs b/src/CLaSH/Driver/TopWrapper.hs --- a/src/CLaSH/Driver/TopWrapper.hs +++ b/src/CLaSH/Driver/TopWrapper.hs @@ -34,9 +34,10 @@ mkTopWrapper :: PrimMap -> Maybe TopEntity -- ^ TopEntity specifications -> String -- ^ Name of the module containing the @topEntity@ + -> Int -- ^ Int/Word/Integer bit-width -> Component -- ^ Entity to wrap -> Component -mkTopWrapper primMap teM modName topComponent +mkTopWrapper primMap teM modName iw topComponent = Component { componentName = maybe (pack modName `append` "_topEntity") (pack . t_name) teM , inputs = inputs'' ++ extraIn teM @@ -54,7 +55,7 @@ iNameSupply = maybe [] (map pack . t_inputs) teM originalHidden = hiddenPorts topComponent - clkDecls = mkClocks primMap originalHidden teM + clkDecls = mkClocks primMap originalHidden iw teM inputs' = map (first (const "input")) (inputs topComponent) @@ -203,8 +204,8 @@ iName = append i (pack ("_" ++ show cnt)) -- | Create clock generators -mkClocks :: PrimMap -> [(Identifier,HWType)] -> Maybe TopEntity -> [Declaration] -mkClocks primMap hidden teM = concat +mkClocks :: PrimMap -> [(Identifier,HWType)] -> Int -> Maybe TopEntity -> [Declaration] +mkClocks primMap hidden iw teM = concat [ clockGens , resets ] @@ -212,7 +213,7 @@ (clockGens,clkLocks) = maybe ([],[]) (first concat . unzip . map mkClock . t_clocks) teM - resets = mkResets primMap hidden clkLocks + resets = mkResets primMap hidden iw clkLocks stringToVar :: String -> Expr stringToVar = (`Identifier` Nothing) . pack @@ -250,9 +251,10 @@ -- | Generate resets mkResets :: PrimMap -> [(Identifier,HWType)] + -> Int -> [(Identifier,[String],Bool)] -> [Declaration] -mkResets primMap hidden = unsafeRunNetlist . fmap concat . mapM assingReset +mkResets primMap hidden iw = unsafeRunNetlist iw . fmap concat . mapM assingReset where assingReset (lock,clks,doSync) = concat <$> mapM connectReset matched where @@ -290,9 +292,11 @@ -- | The 'NetListMonad' is a transformer stack with 'IO' at the bottom. -- So we must use 'unsafePerformIO'. -unsafeRunNetlist :: NetlistMonad a +unsafeRunNetlist :: Int + -> NetlistMonad a -> a -unsafeRunNetlist = unsafePerformIO - . fmap fst - . runNetlistMonad Nothing HashMap.empty HashMap.empty - HashMap.empty (\_ _ -> Nothing) "" [] +unsafeRunNetlist iw + = unsafePerformIO + . fmap fst + . runNetlistMonad Nothing HashMap.empty HashMap.empty + HashMap.empty (\_ _ -> Nothing) "" [] iw diff --git a/src/CLaSH/Driver/Types.hs b/src/CLaSH/Driver/Types.hs --- a/src/CLaSH/Driver/Types.hs +++ b/src/CLaSH/Driver/Types.hs @@ -16,4 +16,5 @@ , opt_inlineBelow :: Int , opt_dbgLevel :: DebugLevel , opt_cleanhdl :: Bool + , opt_intWidth :: Int } diff --git a/src/CLaSH/Netlist.hs b/src/CLaSH/Netlist.hs --- a/src/CLaSH/Netlist.hs +++ b/src/CLaSH/Netlist.hs @@ -8,6 +8,7 @@ import qualified Control.Lens as Lens import Control.Monad.State.Strict (runStateT) import Control.Monad.Writer.Strict (listen, runWriterT, tell) +import Data.Char (ord) import Data.Either (lefts,partitionEithers) import Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Lazy as HashMap @@ -55,11 +56,13 @@ -- ^ Name of the module containing the @topEntity@ -> [(String,FilePath)] -- ^ Set of collected data-files + -> Int + -- ^ Int/Word/Integer bit-width -> TmName -- ^ Name of the @topEntity@ -> IO ([Component],[(String,FilePath)],Int) -genNetlist compCntM globals primMap tcm typeTrans mStart modName dfiles topEntity = do - (_,s) <- runNetlistMonad compCntM globals primMap tcm typeTrans modName dfiles $ genComponent topEntity mStart +genNetlist compCntM globals primMap tcm typeTrans mStart modName dfiles iw topEntity = do + (_,s) <- runNetlistMonad compCntM globals primMap tcm typeTrans modName dfiles iw $ genComponent topEntity mStart return (HashMap.elems $ _components s, _dataFiles s, _cmpCount s) -- | Run a NetlistMonad action in a given environment @@ -77,16 +80,18 @@ -- ^ Name of the module containing the @topEntity@ -> [(String,FilePath)] -- ^ Set of collected data-files + -> Int + -- ^ Int/Word/Integer bit-width -> NetlistMonad a -- ^ Action to run -> IO (a, NetlistState) -runNetlistMonad compCntM s p tcm typeTrans modName dfiles +runNetlistMonad compCntM s p tcm typeTrans modName dfiles iw = runFreshMT . flip runStateT s' . (fmap fst . runWriterT) . runNetlist where - s' = NetlistState s HashMap.empty 0 (fromMaybe 0 compCntM) HashMap.empty p typeTrans tcm modName Text.empty dfiles + s' = NetlistState s HashMap.empty 0 (fromMaybe 0 compCntM) HashMap.empty p typeTrans tcm modName Text.empty dfiles iw -- | Generate a component for a given function (caching) genComponent :: TmName -- ^ Name of the function @@ -226,7 +231,12 @@ (,altDecls) <$> case pat of DefaultPat -> return (Nothing,altExpr) DataPat (Embed dc) _ -> return (Just (dcToLiteral scrutHTy (dcTag dc)),altExpr) - LitPat (Embed (IntegerLiteral i)) -> return (Just (NumLit $ fromInteger i),altExpr) + LitPat (Embed (IntegerLiteral i)) -> return (Just (NumLit i),altExpr) + LitPat (Embed (IntLiteral i)) -> return (Just (NumLit i), altExpr) + LitPat (Embed (WordLiteral w)) -> return (Just (NumLit w), altExpr) + LitPat (Embed (CharLiteral c)) -> return (Just (NumLit . toInteger $ ord c), altExpr) + LitPat (Embed (Int64Literal i)) -> return (Just (NumLit i), altExpr) + LitPat (Embed (Word64Literal w)) -> return (Just (NumLit w), altExpr) _ -> error $ $(curLoc) ++ "Not an integer literal in LitPat" mkScrutExpr :: HWType -> Pat -> Expr -> Expr @@ -301,11 +311,16 @@ -> Type -- ^ Type of the LHS of the let-binder -> Term -- ^ Term to convert to an expression -> NetlistMonad (Expr,[Declaration]) -- ^ Returned expression and a list of generate BlackBox declarations -mkExpr _ _ (Core.Literal lit) = return (HW.Literal (Just (Integer,32)) . NumLit $ fromInteger $! i,[]) - where - i = case lit of - (IntegerLiteral i') -> i' - _ -> error $ $(curLoc) ++ "not an integer literal" +mkExpr _ _ (Core.Literal l) = do + iw <- Lens.use intWidth + case l of + IntegerLiteral i -> return (HW.Literal (Just (Signed iw,iw)) $ NumLit i, []) + IntLiteral i -> return (HW.Literal (Just (Signed iw,iw)) $ NumLit i, []) + WordLiteral w -> return (HW.Literal (Just (Unsigned iw,iw)) $ NumLit w, []) + Int64Literal i -> return (HW.Literal (Just (Signed 64,64)) $ NumLit i, []) + Word64Literal w -> return (HW.Literal (Just (Unsigned 64,64)) $ NumLit w, []) + CharLiteral c -> return (HW.Literal (Just (Unsigned 21,21)) . NumLit . toInteger $ ord c, []) + _ -> error $ $(curLoc) ++ "not an integer or char literal" mkExpr bbEasD ty app = do let (appF,args) = collectArgs app diff --git a/src/CLaSH/Netlist/BlackBox.hs b/src/CLaSH/Netlist/BlackBox.hs --- a/src/CLaSH/Netlist/BlackBox.hs +++ b/src/CLaSH/Netlist/BlackBox.hs @@ -8,6 +8,7 @@ import Control.Lens ((.=),(<<%=)) import qualified Control.Lens as Lens import Control.Monad (filterM) +import Data.Char (ord) import Data.Either (lefts) import qualified Data.HashMap.Lazy as HashMap import qualified Data.IntMap as IntMap @@ -91,14 +92,20 @@ mkArgument e = do tcm <- Lens.use tcCache ty <- termType tcm e + iw <- Lens.use intWidth hwTyM <- N.termHWTypeM e ((e',t,l),d) <- case hwTyM of Nothing -> return ((Identifier "__VOID__" Nothing,Void,False),[]) Just hwTy -> case collectArgs e of (Var _ v,[]) -> let vT = Identifier (mkBasicId . pack $ name2String v) Nothing in return ((vT,hwTy,False),[]) - (C.Literal (IntegerLiteral i),[]) -> return ((N.Literal (Just (Integer,32)) (N.NumLit i),hwTy,True),[]) + (C.Literal (IntegerLiteral i),[]) -> return ((N.Literal (Just (Signed iw,iw)) (N.NumLit i),hwTy,True),[]) + (C.Literal (IntLiteral i), []) -> return ((N.Literal (Just (Signed iw,iw)) (N.NumLit i),hwTy,True),[]) + (C.Literal (WordLiteral w), []) -> return ((N.Literal (Just (Unsigned iw,iw)) (N.NumLit w),hwTy,True),[]) + (C.Literal (CharLiteral c), []) -> return ((N.Literal (Just (Unsigned 21,21)) (N.NumLit . toInteger $ ord c),hwTy,True),[]) (C.Literal (StringLiteral s),[]) -> return ((N.Literal Nothing (N.StringLit s),hwTy,True),[]) + (C.Literal (Int64Literal i), []) -> return ((N.Literal (Just (Signed 64,64)) (N.NumLit i),hwTy,True),[]) + (C.Literal (Word64Literal i), []) -> return ((N.Literal (Just (Unsigned 64,64)) (N.NumLit i),hwTy,True),[]) (Prim f _,args) -> do (e',d) <- mkPrimitive True False f args ty case e' of @@ -150,7 +157,7 @@ | pNm == "GHC.Prim.tagToEnum#" -> do hwTy <- N.unsafeCoreTypeToHWTypeM $(curLoc) ty case args of - [Right (ConstTy (TyCon tcN)), Left (C.Literal (IntegerLiteral i))] -> do + [Right (ConstTy (TyCon tcN)), Left (C.Literal (IntLiteral i))] -> do tcm <- Lens.use tcCache let dcs = tyConDataCons (tcm HashMap.! tcN) dc = dcs !! fromInteger i @@ -171,7 +178,9 @@ return (Identifier tmpS Nothing,[netDeclRhs,netDeclS,netAssignRhs,netAssignS] ++ scrutDecls) _ -> error $ $(curLoc) ++ "tagToEnum: " ++ show (map (either showDoc showDoc) args) | pNm == "GHC.Prim.dataToTag#" -> case args of - [Right _,Left (Data dc)] -> return (N.Literal Nothing (NumLit $ toInteger $ dcTag dc - 1),[]) + [Right _,Left (Data dc)] -> do + iw <- Lens.use intWidth + return (N.Literal (Just (Signed iw,iw)) (NumLit $ toInteger $ dcTag dc - 1),[]) [Right _,Left scrut] -> do i <- varCount <<%= (+1) j <- varCount <<%= (+1) @@ -179,10 +188,11 @@ scrutTy <- termType tcm scrut scrutHTy <- unsafeCoreTypeToHWTypeM $(curLoc) scrutTy (scrutExpr,scrutDecls) <- mkExpr False scrutTy scrut + iw <- Lens.use intWidth let tmpRhs = pack ("tmp_dtt_rhs_" ++ show i) tmpS = pack ("tmp_dtt_" ++ show j) netDeclRhs = NetDecl tmpRhs scrutHTy - netDeclS = NetDecl tmpS Integer + netDeclS = NetDecl tmpS (Signed iw) netAssignRhs = Assignment tmpRhs scrutExpr netAssignS = Assignment tmpS (DataTag scrutHTy (Right tmpRhs)) return (Identifier tmpS Nothing,[netDeclRhs,netDeclS,netAssignRhs,netAssignS] ++ scrutDecls) diff --git a/src/CLaSH/Netlist/BlackBox/Parser.hs b/src/CLaSH/Netlist/BlackBox/Parser.hs --- a/src/CLaSH/Netlist/BlackBox/Parser.hs +++ b/src/CLaSH/Netlist/BlackBox/Parser.hs @@ -81,6 +81,7 @@ <|> Gen <$> (False <$ pToken "~ENDGENERATE") <|> SigD <$> (pToken "~SIGD" *> pBrackets pSigD) <*> (Just <$> (pBrackets pNatural)) <|> (`SigD` Nothing) <$> (pToken "~SIGDO" *> pBrackets pSigD) + <|> IW64 <$ pToken "~IW64" -- | Parse a bracketed text pBrackets :: Parser a -> Parser a diff --git a/src/CLaSH/Netlist/BlackBox/Types.hs b/src/CLaSH/Netlist/BlackBox/Types.hs --- a/src/CLaSH/Netlist/BlackBox/Types.hs +++ b/src/CLaSH/Netlist/BlackBox/Types.hs @@ -30,6 +30,8 @@ | Gen !Bool -- ^ Hole marking beginning (True) or end (False) -- of a generative construct | IF !Element [Element] [Element] + | IW64 -- ^ Hole indicating whether Int/Word/Integer + -- are 64-Bit | SigD [Element] !(Maybe Int) deriving Show diff --git a/src/CLaSH/Netlist/BlackBox/Util.hs b/src/CLaSH/Netlist/BlackBox/Util.hs --- a/src/CLaSH/Netlist/BlackBox/Util.hs +++ b/src/CLaSH/Netlist/BlackBox/Util.hs @@ -190,6 +190,7 @@ return (displayT $ renderOneLine t) renderElem b (IF c t f) = do + iw <- iwWidth let c' = case c of (Size e) -> typeSize (lineToType b [e]) (Length e) -> case lineToType b [e] of @@ -198,7 +199,8 @@ (L n) -> case bbInputs b !! n of (either id fst -> Literal _ (NumLit i),_,_) -> fromInteger i _ -> error $ $(curLoc) ++ "IF: LIT must be a numeric lit" - _ -> error $ $(curLoc) ++ "IF: condition must be: SIZE, LENGHT, or LIT" + IW64 -> if iw == 64 then 1 else 0 + _ -> error $ $(curLoc) ++ "IF: condition must be: SIZE, LENGHT, IW64, or LIT" if c' > 0 then renderBlackBox t b else renderBlackBox f b renderElem b e = renderTag b e @@ -255,8 +257,8 @@ e = either id fst s in (displayT . renderOneLine) <$> expr False (mkLit e) where - mkLit (Literal (Just (Integer,_)) i) = Literal Nothing i - mkLit i = i + mkLit (Literal (Just (Signed _,_)) i) = Literal Nothing i + mkLit i = i renderTag _ (Sym n) = return $ Text.pack ("n_" ++ show n) renderTag b (Typ Nothing) = fmap (displayT . renderOneLine) . hdlType . snd $ bbResult b @@ -284,3 +286,4 @@ renderTag _ CompName = error $ $(curLoc) ++ "Unexpected component name" renderTag _ (IndexType _) = error $ $(curLoc) ++ "Unexpected index type" renderTag _ (FilePath _) = error $ $(curLoc) ++ "Unexpected file name" +renderTag _ IW64 = error $ $(curLoc) ++ "Unexpected IW64" diff --git a/src/CLaSH/Netlist/Id.hs b/src/CLaSH/Netlist/Id.hs --- a/src/CLaSH/Netlist/Id.hs +++ b/src/CLaSH/Netlist/Id.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} -- | Transform/format a Netlist Identifier so that it is acceptable as a HDL identifier @@ -8,6 +9,10 @@ ) where +#ifndef MIN_VERSION_text +#error MIN_VERSION_text undefined +#endif + import Data.Char (isAsciiLower,isAsciiUpper,isDigit,ord) import Data.Text.Lazy as Text import Numeric (showHex) @@ -38,7 +43,9 @@ Just k -> takeWhileEnd (/= '_') k Nothing -> t +#if !MIN_VERSION_text(1,2,2) takeWhileEnd p = Text.reverse . Text.takeWhile p . Text.reverse +#endif stripWorkerPrefix t = case Text.stripPrefix "$w" t of Just k -> k diff --git a/src/CLaSH/Netlist/Types.hs b/src/CLaSH/Netlist/Types.hs --- a/src/CLaSH/Netlist/Types.hs +++ b/src/CLaSH/Netlist/Types.hs @@ -50,6 +50,7 @@ , _modNm :: !String -- ^ Name of the module containing the @topEntity@ , _curCompNm :: !Identifier , _dataFiles :: [(String,FilePath)] + , _intWidth :: Int } -- | Signal reference @@ -79,7 +80,6 @@ = Void -- ^ Empty type | String -- ^ String type | Bool -- ^ Boolean type - | Integer -- ^ Integer type | BitVector !Size -- ^ BitVector of a specified size | Index !Size -- ^ Unsigned integer with specified (exclusive) upper bounder | Signed !Size -- ^ Signed integer of a specified size diff --git a/src/CLaSH/Netlist/Util.hs b/src/CLaSH/Netlist/Util.hs --- a/src/CLaSH/Netlist/Util.hs +++ b/src/CLaSH/Netlist/Util.hs @@ -164,11 +164,10 @@ typeSize :: HWType -> Int typeSize Void = 0 -typeSize String = 2^(32::Integer) +typeSize String = 1 typeSize Bool = 1 typeSize (Clock _ _) = 1 typeSize (Reset _ _) = 1 -typeSize Integer = 32 typeSize (BitVector i) = i typeSize (Index 0) = 0 typeSize (Index 1) = 1 diff --git a/src/CLaSH/Normalize/PrimitiveReductions.hs b/src/CLaSH/Normalize/PrimitiveReductions.hs --- a/src/CLaSH/Normalize/PrimitiveReductions.hs +++ b/src/CLaSH/Normalize/PrimitiveReductions.hs @@ -15,6 +15,7 @@ -- * CLaSH.Sized.Vector.head -- * CLaSH.Sized.Vector.tail -- * CLaSH.Sized.Vector.unconcatBitVector# +-- * CLaSH.Sized.Vector.replicate -- -- Partially handles: -- @@ -400,3 +401,16 @@ changed retVec reduceTranspose _ _ _ _ = error $ $(curLoc) ++ "reduceTranspose: unimplemented" + +reduceReplicate :: Int + -> Type + -> Type + -> Term + -> NormalizeSession Term +reduceReplicate n aTy eTy arg = do + tcm <- Lens.view tcCache + let (TyConApp vecTcNm _) = tyView eTy + (Just vecTc) = HashMap.lookup vecTcNm tcm + [nilCon,consCon] = tyConDataCons vecTc + retVec = mkVec nilCon consCon aTy n (replicate n arg) + changed retVec diff --git a/src/CLaSH/Normalize/Transformations.hs b/src/CLaSH/Normalize/Transformations.hs --- a/src/CLaSH/Normalize/Transformations.hs +++ b/src/CLaSH/Normalize/Transformations.hs @@ -35,6 +35,7 @@ import qualified Control.Lens as Lens import qualified Control.Monad as Monad import Control.Monad.Writer (WriterT (..), lift, tell) +import Control.Monad.Trans.Except (runExcept) import Data.Bits ((.&.), complement) import qualified Data.Either as Either import qualified Data.HashMap.Lazy as HashMap @@ -54,8 +55,7 @@ import CLaSH.Core.Subst (substTm, substTms, substTyInTm, substTysinTm) import CLaSH.Core.Term (LetBinding, Pat (..), Term (..)) -import CLaSH.Core.Type (TypeView (..), Type (..), - LitTy (..), applyFunTy, +import CLaSH.Core.Type (TypeView (..), applyFunTy, applyTy, isPolyFunCoreTy, splitFunTy, typeKind, tyView) @@ -64,7 +64,7 @@ isFun, isLet, isPolyFun, isPrim, isSignalType, isVar, mkApps, mkLams, mkTmApps, mkVec, - termSize, termType) + termSize, termType, tyNatSize) import CLaSH.Core.Var (Id, Var (..)) import CLaSH.Netlist.Util (representableType, splitNormalized) @@ -241,8 +241,15 @@ reduceConstant <- Lens.view evaluator case reduceConstant tcm True subj of Literal l -> caseCon ctx (Case (Literal l) ty alts) - subj'@(collectArgs -> (Data _,_)) -> caseCon ctx (Case subj' ty alts) - subj' -> traceIf (lvl > DebugNone) ("Irreducible constant as case subject: " ++ showDoc subj ++ "\nCan be reduced to: " ++ showDoc subj') (caseOneAlt e) + subj' -> case collectArgs subj' of + (Data _,_) -> caseCon ctx (Case subj' ty alts) + (Prim nm ty',[_,msg]) + | nm == "Control.Exception.Base.patError" -> + let e' = mkApps (Prim nm ty') [Right ty,msg] + in changed e' + _ -> traceIf (lvl > DebugNone) + ("Irreducible constant as case subject: " ++ showDoc subj ++ "\nCan be reduced to: " ++ showDoc subj') + (caseOneAlt e) caseCon _ e = caseOneAlt e @@ -848,13 +855,16 @@ -- * CLaSH.Sized.Vector.(++) -- * CLaSH.Sized.Vector.head -- * CLaSH.Sized.Vector.tail +-- * CLaSH.Sized.Vector.unconcat +-- * CLaSH.Sized.Vector.transpose +-- * CLaSH.Sized.Vector.replicate reduceNonRepPrim :: NormRewrite reduceNonRepPrim _ e@(App _ _) | (Prim f _, args) <- collectArgs e = do tcm <- Lens.view tcCache eTy <- termType tcm e case tyView eTy of (TyConApp vecTcNm@(name2String -> "CLaSH.Sized.Vector.Vec") - [LitTy (NumTy 0), aTy]) -> do + [runExcept . tyNatSize tcm -> Right 0, aTy]) -> do let (Just vecTc) = HashMap.lookup vecTcNm tcm [nilCon,consCon] = tyConDataCons vecTc nilE = mkVec nilCon consCon aTy 0 [] @@ -862,8 +872,8 @@ _ -> case f of "CLaSH.Sized.Vector.zipWith" | length args == 7 -> do let [lhsElTy,rhsElty,resElTy,nTy] = Either.rights args - case nTy of - (LitTy (NumTy n)) -> do + case runExcept (tyNatSize tcm nTy) of + Right n -> do untranslatableTys <- mapM isUntranslatableType [lhsElTy,rhsElty,resElTy] if or untranslatableTys then let [fun,lhsArg,rhsArg] = Either.lefts args @@ -872,8 +882,8 @@ _ -> return e "CLaSH.Sized.Vector.map" | length args == 5 -> do let [argElTy,resElTy,nTy] = Either.rights args - case nTy of - (LitTy (NumTy n)) -> do + case runExcept (tyNatSize tcm nTy) of + Right n -> do untranslatableTys <- mapM isUntranslatableType [argElTy,resElTy] if or untranslatableTys then let [fun,arg] = Either.lefts args @@ -882,8 +892,8 @@ _ -> return e "CLaSH.Sized.Vector.traverse#" | length args == 7 -> let [aTy,fTy,bTy,nTy] = Either.rights args - in case nTy of - (LitTy (NumTy n)) -> + in case runExcept (tyNatSize tcm nTy) of + Right n -> let [dict,fun,arg] = Either.lefts args in reduceTraverse n aTy fTy bTy dict fun arg _ -> return e @@ -891,15 +901,15 @@ let [aTy,nTy] = Either.rights args isPow2 x = x /= 0 && (x .&. (complement x + 1)) == x untranslatableTy <- isUntranslatableType aTy - case nTy of - (LitTy (NumTy n)) | not (isPow2 (n + 1)) || untranslatableTy -> + case runExcept (tyNatSize tcm nTy) of + Right n | not (isPow2 (n + 1)) || untranslatableTy -> let [fun,arg] = Either.lefts args in reduceFold (n + 1) aTy fun arg _ -> return e "CLaSH.Sized.Vector.foldr" | length args == 6 -> let [aTy,bTy,nTy] = Either.rights args - in case nTy of - (LitTy (NumTy n)) -> do + in case runExcept (tyNatSize tcm nTy) of + Right n -> do untranslatableTys <- mapM isUntranslatableType [aTy,bTy] if or untranslatableTys then let [fun,start,arg] = Either.lefts args @@ -907,15 +917,15 @@ else return e _ -> return e "CLaSH.Sized.Vector.dfold" | length args == 8 -> - let ([_kn,_motive,fun,start,arg],[_mTy,nTy,aTy]) = Either.partitionEithers args - in case nTy of - (LitTy (NumTy n)) -> reduceDFold n aTy fun start arg - _ -> return e + let ([kn,_motive,fun,start,arg],[_mTy,nTy,aTy]) = Either.partitionEithers args + in case runExcept (tyNatSize tcm nTy) of + Right n -> reduceDFold n aTy fun start arg + _ -> error $ "DIE!\n" ++ show kn "CLaSH.Sized.Vector.++" | length args == 5 -> let [nTy,aTy,mTy] = Either.rights args [lArg,rArg] = Either.lefts args - in case (nTy,mTy) of - (LitTy (NumTy n), LitTy (NumTy m)) + in case (runExcept (tyNatSize tcm nTy), runExcept (tyNatSize tcm mTy)) of + (Right n, Right m) | n == 0 -> changed rArg | m == 0 -> changed lArg | otherwise -> do @@ -927,8 +937,8 @@ "CLaSH.Sized.Vector.head" | length args == 3 -> do let [nTy,aTy] = Either.rights args [vArg] = Either.lefts args - case nTy of - (LitTy (NumTy n)) -> do + case runExcept (tyNatSize tcm nTy) of + Right n -> do untranslatableTy <- isUntranslatableType aTy if untranslatableTy then reduceHead n aTy vArg @@ -937,8 +947,8 @@ "CLaSH.Sized.Vector.tail" | length args == 3 -> do let [nTy,aTy] = Either.rights args [vArg] = Either.lefts args - case nTy of - (LitTy (NumTy n)) -> do + case runExcept (tyNatSize tcm nTy) of + Right n -> do untranslatableTy <- isUntranslatableType aTy if untranslatableTy then reduceTail n aTy vArg @@ -946,14 +956,24 @@ _ -> return e "CLaSH.Sized.Vector.unconcat" | length args == 6 -> do let ([_knN,_sm,arg],[mTy,nTy,aTy]) = Either.partitionEithers args - case (nTy,mTy) of - (LitTy (NumTy n), LitTy (NumTy 0)) -> reduceUnconcat n 0 aTy arg + case (runExcept (tyNatSize tcm nTy), runExcept (tyNatSize tcm mTy)) of + (Right n, Right 0) -> reduceUnconcat n 0 aTy arg _ -> return e "CLaSH.Sized.Vector.transpose" | length args == 5 -> do let ([_knN,arg],[mTy,nTy,aTy]) = Either.partitionEithers args - case (nTy,mTy) of - (LitTy (NumTy n), LitTy (NumTy 0)) -> reduceTranspose n 0 aTy arg + case (runExcept (tyNatSize tcm nTy), runExcept (tyNatSize tcm mTy)) of + (Right n, Right 0) -> reduceTranspose n 0 aTy arg _ -> return e + "CLaSH.Sized.Vector.replicate" | length args == 4 -> do + let ([_sArg,vArg],[nTy,aTy]) = Either.partitionEithers args + case runExcept (tyNatSize tcm nTy) of + Right n -> do + untranslatableTy <- isUntranslatableType aTy + if untranslatableTy + then reduceReplicate n aTy eTy vArg + else return e + _ -> return e + _ -> return e reduceNonRepPrim _ e = return e diff --git a/src/Unbound/Generics/LocallyNameless/Extra.hs b/src/Unbound/Generics/LocallyNameless/Extra.hs --- a/src/Unbound/Generics/LocallyNameless/Extra.hs +++ b/src/Unbound/Generics/LocallyNameless/Extra.hs @@ -7,11 +7,10 @@ module Unbound.Generics.LocallyNameless.Extra where #ifndef MIN_VERSION_unbound_generics -#define MIN_VERSION_unbound_generics(x,y,z)(1) +#error MIN_VERSION_unbound_generics undefined #endif -#if MIN_VERSION_unbound_generics(0,2,0) -#else +#if !MIN_VERSION_unbound_generics(0,2,0) import Control.DeepSeq #endif import Data.Hashable (Hashable(..),hash) @@ -26,21 +25,18 @@ #else import Unbound.Generics.LocallyNameless.Alpha (Alpha (..)) #endif -#if MIN_VERSION_unbound_generics(0,2,0) -#else +#if !MIN_VERSION_unbound_generics(0,2,0) import Unbound.Generics.LocallyNameless.Bind (Bind (..)) import Unbound.Generics.LocallyNameless.Embed (Embed (..)) #endif import Unbound.Generics.LocallyNameless.Name (Name (..)) -#if MIN_VERSION_unbound_generics(0,2,0) -#else +#if !MIN_VERSION_unbound_generics(0,2,0) import Unbound.Generics.LocallyNameless.Rebind (Rebind (..)) import Unbound.Generics.LocallyNameless.Rec (Rec,unrec) #endif import Unbound.Generics.LocallyNameless.Subst (Subst (..)) -#if MIN_VERSION_unbound_generics(0,2,0) -#else +#if !MIN_VERSION_unbound_generics(0,2,0) instance (NFData a, NFData b) => NFData (Bind a b) instance NFData a => NFData (Embed a) instance NFData (Name a) @@ -57,8 +53,7 @@ hashWithSalt salt (Fn str int) = hashWithSalt salt (hashWithSalt (hash int) str) hashWithSalt salt (Bn i0 i1) = hashWithSalt salt (hash i0 `hashWithSalt` i1) -#if MIN_VERSION_unbound_generics(0,2,0) -#else +#if !MIN_VERSION_unbound_generics(0,2,0) instance (Ord a) => Ord (Embed a) where compare (Embed a) (Embed b) = compare a b #endif