diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,8 +1,23 @@ # Changelog for the [`clash-lib`](http://hackage.haskell.org/package/clash-lib) package +## 0.7.1 *April 11th 2017* +* New features: + * Support distribution of primitive templates with Cabal/Hackage packages [commit](https://github.com/clash-lang/clash-compiler/commit/82cd31863aafcbaf3bdbf7746d89d13859af5aaf) + * Find memory data files and primitive files relative to import dirs (`-i`) +* Fixes bugs: + * `case (EmptyCase ty) of ty' { ... }` -> `EmptyCase ty'` [#198](https://github.com/clash-lang/clash-compiler/issues/198) + * `BitVector.split#` apply the correct type arguments + ## 0.7 *January 16th 2017* * New features: * Support for `clash-prelude` 0.11 + * Primitive templates can include QSys files + * VHDL blackboxes: support additional libraries and uses keywords in generated VHDL + * Highly limited Float/Double support (literals and `Rational` conversion), hidden behind the `-clash-float-support` flag. +* Fixes bugs: + * Reduce type families inside clock period calculation [#180](https://github.com/clash-lang/clash-compiler/issues/180) + * Only output signed literals as hex when they're multiple of 4 bits [#187](https://github.com/clash-lang/clash-compiler/issues/187) + * Correctly print negative hex literals ## 0.6.21 *August 18th 2016* * Fixes bugs: 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.7 +Version: 0.7.1 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 @@ -16,11 +16,16 @@ import CLaSH.Netlist.Types import CLaSH.Netlist.BlackBox.Types +import CLaSH.Annotations.Primitive (HDL) + type ModName = String class Backend state where -- | Initial state for state monad initBackend :: Int -> HdlSyn -> state + + -- | What HDL is the backend generating + hdlKind :: state -> HDL -- | Location for the primitive definitions primDir :: state -> IO FilePath diff --git a/src/CLaSH/Driver.hs b/src/CLaSH/Driver.hs --- a/src/CLaSH/Driver.hs +++ b/src/CLaSH/Driver.hs @@ -1,5 +1,5 @@ {-| - Copyright : (C) 2012-2016, University of Twente + Copyright : (C) 2012-2016, University of Twente, 2017, QBayLogic License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij @@ -13,7 +13,7 @@ import qualified Control.Concurrent.Supply as Supply import Control.DeepSeq -import Control.Monad (when) +import Control.Monad (when, unless) import Control.Monad.State (evalState, get) import qualified Data.HashMap.Lazy as HML import Data.HashMap.Strict (HashMap) @@ -130,7 +130,7 @@ takeWhile (/= '.') (name2String topEntity) prepareDir (opt_cleanhdl opts) (extension hdlState') dir mapM_ (writeHDL dir) hdlDocs - copyDataFiles dir dfiles' + copyDataFiles (opt_importPaths opts) dir dfiles' endTime <- hdlDocs `seq` Clock.getCurrentTime let startEndDiff = Clock.diffUTCTime endTime startTime @@ -190,7 +190,25 @@ IO.hPutStr handle "\n" IO.hClose handle -copyDataFiles :: FilePath -> [(String,FilePath)] -> IO () -copyDataFiles dir = mapM_ copyFile' +copyDataFiles :: [FilePath] -> FilePath -> [(String,FilePath)] -> IO () +copyDataFiles idirs dir = mapM_ (copyFile' idirs) where - copyFile' (nm,old) = Directory.copyFile old (dir FilePath. nm) + copyFile' dirs (nm,old) = do + oldExists <- Directory.doesFileExist old + if oldExists + then Directory.copyFile old new + else goImports dirs + where + new = dir FilePath. nm + + goImports [] = do + oldExists <- Directory.doesFileExist old + if oldExists + then Directory.copyFile old new + else unless (null old) (putStrLn ("WARNING: file " ++ show old ++ " does not exist")) + goImports (d:ds) = do + let old2 = d FilePath. old + old2Exists <- Directory.doesFileExist old2 + if old2Exists + then Directory.copyFile old2 new + else goImports ds 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 @@ -1,5 +1,5 @@ {-| - Copyright : (C) 2013-2016, University of Twente + Copyright : (C) 2013-2016, University of Twente, 2017, QBayLogic License : BSD2 (see the file LICENSE) Maintainer : Christiaan Baaij @@ -37,6 +37,8 @@ , opt_errorExtra :: Bool , opt_floatSupport :: Bool , opt_allowZero :: Bool + , opt_importPaths :: [FilePath] + , opt_errorInvalidCoercions :: Bool } data CLaSHException = CLaSHException SrcSpan String (Maybe String) diff --git a/src/CLaSH/Netlist.hs b/src/CLaSH/Netlist.hs --- a/src/CLaSH/Netlist.hs +++ b/src/CLaSH/Netlist.hs @@ -136,8 +136,16 @@ Nothing -> do (_,sp) <- Lens.use curCompNm throw (CLaSHException sp ($(curLoc) ++ "No normalized expression found for: " ++ show compName) Nothing) - Just (_,_,expr_) -> makeCached compName components $ - genComponentT compName expr_ mStart + Just (_,_,expr_) -> do + c@(_,Component _ clks _ _ _) <- makeCached compName components $ genComponentT compName expr_ mStart + -- This might seem redundant, because you think `genComponentT` already + -- added those clocks, right? wrong! + -- + -- `makeCached` stores the value returned by a monadic action, so when + -- we use a cached result, its clocks weren't added to the current + -- writer which is keeping track of used clock ports. + tell (fromList clks) + return c -- | Generate a component for a given function genComponentT :: TmName -- ^ Name of the function @@ -452,4 +460,9 @@ RTree _ _ -> case argExprs of [_,e1,e2] -> return (HW.DataCon dstHType RTreeAppend [e1,e2]) _ -> error $ $(curLoc) ++ "Unexpected number of arguments for `BR`: " ++ showDoc args + String -> + let dc' = case dcTag dc of + 1 -> HW.Literal Nothing (StringLit "") + _ -> error $ $(curLoc) ++ "mkDcApplication undefined for: " ++ show (dstHType,dc,dcTag dc,args,argHWTys) + in return dc' _ -> error $ $(curLoc) ++ "mkDcApplication undefined for: " ++ show (dstHType,dc,args,argHWTys) 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 @@ -168,6 +168,7 @@ BlackBoxE "GHC.CString.unpackCString#" _ _ _ _ bbCtx' _ -> case bbInputs bbCtx' of [(Left (Literal Nothing (StringLit s')),_,_)] -> renderFilePath fs s' _ -> (fs',FilePath e) + Literal Nothing (StringLit s') -> renderFilePath fs s' _ -> (fs',FilePath e) _ -> (fs',FilePath e) findAndSet fs' l = (fs',l) @@ -238,17 +239,20 @@ (Length e) -> case lineToType b [e] of (Vector n _) -> n _ -> error $ $(curLoc) ++ "IF: veclen of a non-vector type" - (L n) -> case bbInputs b !! n of - (either id fst -> Literal _ l,_,_) -> - case l of - NumLit i -> fromInteger i - BitLit bl -> case bl of - N.H -> 1 - N.L -> 0 - _ -> error $ $(curLoc) ++ "IF: LIT bit literal must be high or low" - BoolLit bl -> bool 0 1 bl - _ -> error $ $(curLoc) ++ "IF: LIT must be a numeric lit" - _ -> error $ $(curLoc) ++ "IF: LIT must be a numeric lit" + (L n) -> case bbInputs b !! n of + (l,_,_) + | Literal _ l' <- either id fst l -> + case l' of + NumLit i -> fromInteger i + BitLit bl -> case bl of + N.H -> 1 + N.L -> 0 + _ -> error $ $(curLoc) ++ "IF: LIT bit literal must be high or low" + BoolLit bl -> bool 0 1 bl + _ -> error $ $(curLoc) ++ "IF: LIT must be a numeric lit" + | DataCon (Signed _) _ [Literal _ (NumLit i)] <- either id fst l + -> fromInteger i + k -> error $ $(curLoc) ++ ("IF: LIT must be a numeric lit:" ++ show k) (Depth e) -> case lineToType b [e] of (RTree n _) -> n _ -> error $ $(curLoc) ++ "IF: treedepth of non-tree type" 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 @@ -195,10 +195,10 @@ , show cf , "\nType of the subject is: " ++ showDoc ty , "\nFunction " ++ show cf - , "will not reach a normal form, and compilation" - , "might fail." + , " will not reach a normal form, and compilation" + , " might fail." , "\nRun with '-clash-inline-limit=N' to increase" - , "the inlining limit to N." + , " the inlining limit to N." ]) (return e) else do @@ -273,6 +273,9 @@ | nm `elem` ["CLaSH.Transformations.undefined"] -> let e' = mkApps (Prim nm ty') [Right ty] in changed e' + (Prim nm _,[]) + | nm `elem` ["EmptyCase"] -> + changed (Prim nm ty) _ -> traceIf (lvl > DebugNone) ("Irreducible constant as case subject: " ++ showDoc subj ++ "\nCan be reduced to: " ++ showDoc subj') (caseOneAlt e) @@ -1145,7 +1148,8 @@ [Right lTy ,Right rTy ,Left bvArg - ,Left (Prim "CLaSH.Transformations.removedArg" lTy) + ,Left (mkApps (Prim "CLaSH.Transformations.removedArg" undefinedTy) + [Right rTy]) ] changed tup @@ -1155,7 +1159,8 @@ tup = mkApps (Data tupDc) [Right lTy ,Right rTy - ,Left (Prim "CLaSH.Transformations.removedArg" lTy) + ,Left (mkApps (Prim "CLaSH.Transformations.removedArg" undefinedTy) + [Right lTy]) ,Left bvArg ] diff --git a/src/CLaSH/Primitives/Util.hs b/src/CLaSH/Primitives/Util.hs --- a/src/CLaSH/Primitives/Util.hs +++ b/src/CLaSH/Primitives/Util.hs @@ -26,11 +26,16 @@ -> IO (PrimMap Text) generatePrimMap filePaths = do primitiveFiles <- fmap concat $ mapM - (\filePath -> - fmap ( map (FilePath.combine filePath) - . filter (isSuffixOf ".json") - ) (Directory.getDirectoryContents filePath) - ) filePaths + (\filePath -> do + fpExists <- Directory.doesDirectoryExist filePath + if fpExists + then + fmap ( map (FilePath.combine filePath) + . filter (isSuffixOf ".json") + ) (Directory.getDirectoryContents filePath) + else + return [] + ) filePaths primitives <- fmap concat $ mapM ( return