packages feed

clash-lib 0.6.9 → 0.6.10

raw patch · 6 files changed

+38/−30 lines, 6 files

Files

CHANGELOG.md view
@@ -1,5 +1,12 @@ # Changelog for the [`clash-lib`](http://hackage.haskell.org/package/clash-lib) package +## 0.6.10+* New features:+  * hdl files can be written to a directory other than the current working directory [#125](https://github.com/clash-lang/clash-compiler/issues/125)+* Fixes bugs:+  * `caseCon` transformation does not work on non-exhaustive case-expressions [#123](https://github.com/clash-lang/clash-compiler/issues/123)+  * Primitive reductions don't look through `Signal` [#126](https://github.com/clash-lang/clash-compiler/issues/126)+ ## 0.6.9 * Fixes bugs:   * `case undefined of ...` should reduce to `undefined` [#116](https://github.com/clash-lang/clash-compiler/issues/109)
clash-lib.cabal view
@@ -1,5 +1,5 @@ Name:                 clash-lib-Version:              0.6.9+Version:              0.6.10 Synopsis:             CAES Language for Synchronous Hardware - As a Library Description:   CλaSH (pronounced ‘clash’) is a functional hardware description language that
src/CLaSH/Driver.hs view
@@ -24,6 +24,7 @@ import qualified Data.Text.Lazy                   as Text import qualified Data.Time.Clock                  as Clock import qualified System.Directory                 as Directory+import           System.FilePath                  ((</>), (<.>)) import qualified System.FilePath                  as FilePath import qualified System.IO                        as IO import           Text.PrettyPrint.Leijen.Text     (Doc, hPutDoc)@@ -114,10 +115,9 @@   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)-                   , "/"-                   ]+      dir = fromMaybe "." (opt_hdlDir opts) </>+            CLaSH.Backend.name hdlState' </>+            takeWhile (/= '.') (name2String topEntity)   prepareDir (opt_cleanhdl opts) (extension hdlState') dir   mapM_ (writeHDL hdlState' dir) hdlDocs   copyDataFiles dir dfiles'@@ -170,7 +170,7 @@ -- | Writes a HDL file to the given directory writeHDL :: Backend backend => backend -> FilePath -> (String, Doc) -> IO () writeHDL backend dir (cname, hdl) = do-  handle <- IO.openFile (dir ++ cname ++ CLaSH.Backend.extension backend) IO.WriteMode+  handle <- IO.openFile (dir </> cname <.> CLaSH.Backend.extension backend) IO.WriteMode   hPutDoc handle hdl   IO.hPutStr handle "\n"   IO.hClose handle
src/CLaSH/Driver/Types.hs view
@@ -24,4 +24,5 @@                            , opt_dbgLevel    :: DebugLevel                            , opt_cleanhdl    :: Bool                            , opt_intWidth    :: Int+                           , opt_hdlDir      :: Maybe String                            }
src/CLaSH/Normalize/PrimitiveReductions.hs view
@@ -42,9 +42,9 @@ import           CLaSH.Core.Literal               (Literal (..)) import           CLaSH.Core.Term                  (Term (..), Pat (..)) import           CLaSH.Core.Type                  (LitTy (..), Type (..),-                                                   TypeView (..), mkFunTy,-                                                   mkTyConApp, splitFunForallTy,-                                                   tyView)+                                                   TypeView (..), coreView,+                                                   mkFunTy, mkTyConApp,+                                                   splitFunForallTy) import           CLaSH.Core.TyCon                 (TyConName, tyConDataCons) import           CLaSH.Core.TysPrim               (typeNatKind) import           CLaSH.Core.Util                  (appendToVec, extractElems,@@ -70,7 +70,7 @@               -> NormalizeSession Term reduceZipWith n lhsElTy rhsElTy resElTy fun lhsArg rhsArg = do   tcm <- Lens.view tcCache-  (TyConApp vecTcNm _) <- tyView <$> termType tcm lhsArg+  (TyConApp vecTcNm _) <- coreView tcm <$> termType tcm lhsArg   let (Just vecTc)     = HashMap.lookup vecTcNm tcm       [nilCon,consCon] = tyConDataCons vecTc       (varsL,elemsL)   = second concat . unzip@@ -93,7 +93,7 @@           -> NormalizeSession Term reduceMap n argElTy resElTy fun arg = do   tcm <- Lens.view tcCache-  (TyConApp vecTcNm _) <- tyView <$> termType tcm arg+  (TyConApp vecTcNm _) <- coreView tcm <$> termType tcm arg   let (Just vecTc)     = HashMap.lookup vecTcNm tcm       [nilCon,consCon] = tyConDataCons vecTc       (vars,elems)     = second concat . unzip@@ -116,8 +116,8 @@                -> NormalizeSession Term reduceTraverse n aTy fTy bTy dict fun arg = do   tcm <- Lens.view tcCache-  (TyConApp vecTcNm    _) <- tyView <$> termType tcm arg-  (TyConApp apDictTcNm _) <- tyView <$> termType tcm dict+  (TyConApp vecTcNm    _) <- coreView tcm <$> termType tcm arg+  (TyConApp apDictTcNm _) <- coreView tcm <$> termType tcm dict   let (Just apDictTc)    = HashMap.lookup apDictTcNm tcm       [apDictCon]        = tyConDataCons apDictTc       (Just apDictIdTys) = dataConInstArgTys apDictCon [fTy]@@ -128,7 +128,7 @@                                                        ,"apConstR"])                                       (map embed apDictIdTys) -      (TyConApp funcDictTcNm _) = tyView (head apDictIdTys)+      (TyConApp funcDictTcNm _) = coreView tcm (head apDictIdTys)       (Just funcDictTc) = HashMap.lookup funcDictTcNm tcm       [funcDictCon] = tyConDataCons funcDictTc       (Just funcDictIdTys) = dataConInstArgTys funcDictCon [fTy]@@ -234,7 +234,7 @@             -> NormalizeSession Term reduceFoldr n aTy _bTy fun start arg = do   tcm <- Lens.view tcCache-  (TyConApp vecTcNm _) <- tyView <$> termType tcm arg+  (TyConApp vecTcNm _) <- coreView tcm <$> termType tcm arg   let (Just vecTc)     = HashMap.lookup vecTcNm tcm       [_,consCon]      = tyConDataCons vecTc       (vars,elems)     = second concat . unzip@@ -253,7 +253,7 @@            -> NormalizeSession Term reduceFold n aTy fun arg = do     tcm <- Lens.view tcCache-    (TyConApp vecTcNm _) <- tyView <$> termType tcm arg+    (TyConApp vecTcNm _) <- coreView tcm <$> termType tcm arg     let (Just vecTc)     = HashMap.lookup vecTcNm tcm         [_,consCon]      = tyConDataCons vecTc         (vars,elems)     = second concat . unzip@@ -279,18 +279,18 @@             -> NormalizeSession Term reduceDFold n aTy fun start arg = do     tcm <- Lens.view tcCache-    (TyConApp vecTcNm _) <- tyView <$> termType tcm arg+    (TyConApp vecTcNm _) <- coreView tcm <$> termType tcm arg     let (Just vecTc)     = HashMap.lookup vecTcNm tcm         [_,consCon]      = tyConDataCons vecTc         (vars,elems)     = second concat . unzip                          $ extractElems consCon aTy 'D' n arg-    ([_ltv,Right snTy,_etaTy,_eta1Ty],_) <- splitFunForallTy <$> termType tcm fun-    let (TyConApp snatTcNm _) = tyView snTy+    (_ltv:Right snTy:_,_) <- splitFunForallTy <$> termType tcm fun+    let (TyConApp snatTcNm _) = coreView tcm snTy         (Just snatTc)         = HashMap.lookup snatTcNm tcm         [snatDc]              = tyConDataCons snatTc          ([_nTv,_kn,Right pTy],_) = splitFunForallTy (dcType snatDc)-        (TyConApp proxyTcNm _)   = tyView pTy+        (TyConApp proxyTcNm _)   = coreView tcm pTy         (Just proxyTc)           = HashMap.lookup proxyTcNm tcm         [proxyDc]                = tyConDataCons proxyTc @@ -323,7 +323,7 @@            -> NormalizeSession Term reduceHead n aTy vArg = do   tcm <- Lens.view tcCache-  (TyConApp vecTcNm _) <- tyView <$> termType tcm vArg+  (TyConApp vecTcNm _) <- coreView tcm <$> termType tcm vArg   let (Just vecTc)  = HashMap.lookup vecTcNm tcm       [_,consCon]   = tyConDataCons vecTc       (vars,elems)  = second concat . unzip@@ -340,7 +340,7 @@            -> NormalizeSession Term reduceTail n aTy vArg = do   tcm <- Lens.view tcCache-  (TyConApp vecTcNm _) <- tyView <$> termType tcm vArg+  (TyConApp vecTcNm _) <- coreView tcm <$> termType tcm vArg   let (Just vecTc) = HashMap.lookup vecTcNm tcm       [_,consCon]  = tyConDataCons vecTc       (_,elems)    = second concat . unzip@@ -360,7 +360,7 @@              -> NormalizeSession Term reduceAppend n m aTy lArg rArg = do   tcm <- Lens.view tcCache-  (TyConApp vecTcNm _) <- tyView <$> termType tcm lArg+  (TyConApp vecTcNm _) <- coreView tcm <$> termType tcm lArg   let (Just vecTc) = HashMap.lookup vecTcNm tcm       [_,consCon]  = tyConDataCons vecTc       (vars,elems) = second concat . unzip@@ -379,7 +379,7 @@                -> NormalizeSession Term reduceUnconcat n 0 aTy arg = do   tcm <- Lens.view tcCache-  (TyConApp vecTcNm _) <- tyView <$> termType tcm arg+  (TyConApp vecTcNm _) <- coreView tcm <$> termType tcm arg   let (Just vecTc)     = HashMap.lookup vecTcNm tcm       [nilCon,consCon] = tyConDataCons vecTc       nilVec           = mkVec nilCon consCon aTy 0 []@@ -399,7 +399,7 @@                 -> NormalizeSession Term reduceTranspose n 0 aTy arg = do   tcm <- Lens.view tcCache-  (TyConApp vecTcNm _) <- tyView <$> termType tcm arg+  (TyConApp vecTcNm _) <- coreView tcm <$> termType tcm arg   let (Just vecTc)     = HashMap.lookup vecTcNm tcm       [nilCon,consCon] = tyConDataCons vecTc       nilVec           = mkVec nilCon consCon aTy 0 []@@ -416,7 +416,7 @@                 -> NormalizeSession Term reduceReplicate n aTy eTy arg = do   tcm <- Lens.view tcCache-  let (TyConApp vecTcNm _) = tyView eTy+  let (TyConApp vecTcNm _) = coreView tcm eTy       (Just vecTc) = HashMap.lookup vecTcNm tcm       [nilCon,consCon] = tyConDataCons vecTc       retVec = mkVec nilCon consCon aTy n (replicate n arg)
src/CLaSH/Normalize/Transformations.hs view
@@ -210,7 +210,7 @@ -- the subject is (an application of) a DataCon; or if there is only a single -- alternative that doesn't reference variables bound by the pattern. caseCon :: NormRewrite-caseCon _ c@(Case scrut _ alts)+caseCon _ (Case scrut ty alts)   | (Data dc, args) <- collectArgs scrut   = do     alts' <- mapM unbind alts@@ -228,7 +228,7 @@         in  changed (substTysinTm substTyMap e')       _ -> case alts' of              ((DefaultPat,e):_) -> changed e-             _ -> error $ $(curLoc) ++ "Report as bug: caseCon error: " ++ showDoc c+             _ -> changed (mkApps (Prim "GHC.Err.undefined" undefinedTy) [Right ty])   where     equalCon dc (DataPat dc' _) = dcTag dc == dcTag (unembed dc')     equalCon _  _               = False@@ -975,10 +975,10 @@               else return e           _ -> return e       "CLaSH.Sized.Vector.dfold" | length args == 8 ->-        let ([kn,_motive,fun,start,arg],[_mTy,nTy,aTy]) = Either.partitionEithers args+        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+          _ -> return e       "CLaSH.Sized.Vector.++" | length args == 5 ->         let [nTy,aTy,mTy] = Either.rights args             [lArg,rArg]   = Either.lefts args