clash-lib 0.2.2 → 0.2.2.1

raw patch · 4 files changed

+29/−18 lines, 4 files

Files

• clash-lib.cabal +2/−2
• src/CLaSH/Normalize.hs +16/−8
• src/CLaSH/Normalize/Strategy.hs +4/−4
• src/CLaSH/Rewrite/Util.hs +7/−4

@@ -1,5 +1,5 @@ Name:                 clash-lib-Version:              0.2.2+Version:              0.2.2.1 Synopsis:             CAES Language for Synchronous Hardware - As a Library Description:   CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -28,7 +28,7 @@   * <https://github.com/christiaanb/clash2 GHC/Haskell Frontend>   .   .-  Prelude library: http://hackage.haskell.org/package/clash-prelude+  Prelude library: <http://hackage.haskell.org/package/clash-prelude> Homepage:             http://christiaanb.github.io/clash2 bug-reports:          http://github.com/christiaanb/clash2/issues License:              OtherLicense

@@ -152,15 +152,23 @@     used   = Set.toList $ termFreeIds $ snd rootTm     other  = map (mkCallTree (root:visited) bindingMap) (filter (`notElem` visited) used) -stripArgs :: [Id]+stripArgs :: [TmName]+          -> [Id]           -> [Either Term Type]           -> Maybe [Either Term Type]-stripArgs (_:_) []   = Nothing-stripArgs []    args = Just args-stripArgs (id_:ids) (Left (Var _ nm):args)-      | varName id_ == nm = stripArgs ids args+stripArgs _      (_:_) []   = Nothing+stripArgs allIds []    args = if any mentionsId args+                                then Nothing+                                else Just args+  where+    mentionsId t = case t of+                     (Left (Var _ nm)) | nm `elem` allIds -> True+                     _ -> False++stripArgs allIds (id_:ids) (Left (Var _ nm):args)+      | varName id_ == nm = stripArgs allIds ids args       | otherwise         = Nothing-stripArgs _ _ = Nothing+stripArgs _ _ _ = Nothing  flattenNode :: CallTree             -> NormalizeSession (Either CallTree ((TmName,Term),[CallTree]))@@ -169,7 +177,7 @@   case norm of     Right (ids,[(_,bExpr)],_) -> do       let (fun,args) = collectArgs (unembed bExpr)-      case stripArgs (reverse ids) (reverse args) of+      case stripArgs (map varName ids) (reverse ids) (reverse args) of         Just remainder -> return (Right ((nm,mkApps fun (reverse remainder)),[]))         Nothing        -> return (Left c)     _ -> return (Left c)@@ -178,7 +186,7 @@   case norm of     Right (ids,[(_,bExpr)],_) -> do       let (fun,args) = collectArgs (unembed bExpr)-      case stripArgs (reverse ids) (reverse args) of+      case stripArgs (map varName ids) (reverse ids) (reverse args) of         Just remainder -> return (Right ((nm,mkApps fun (reverse remainder)),us))         Nothing        -> return (Left b)     _ -> return (Left b)

@@ -19,10 +19,11 @@     bindConst  = topdownR (apply "bindConstantVar" bindConstantVar)  constantPropgation :: NormRewrite-constantPropgation = propagate >-> spec+constantPropgation = propagate >-> lifting >-> spec   where     propagate = innerMost (applyMany transInner) >-> inlining-    inlining  = bottomupR (applyMany transBUP) !-> propagate+    inlining  = topdownR (applyMany transBUP !-> propagate)+    lifting   = bottomupR (apply "liftNonRep" liftNonRep)     spec      = bottomupR (applyMany specRws)      transInner :: [(String,NormRewrite)]@@ -40,8 +41,7 @@                ]      specRws :: [(String,NormRewrite)]-    specRws = [ ("liftNonRep"  , liftNonRep)-              , ("typeSpec"    , typeSpec)+    specRws = [ ("typeSpec"    , typeSpec)               , ("constantSpec", constantSpec)               , ("nonRepSpec"  , nonRepSpec)               ]

@@ -43,7 +43,7 @@ import           CLaSH.Core.TyCon            (TyCon, TyConName, tyConDataCons) import           CLaSH.Core.Type             (KindOrType, TyName, Type (..),                                               TypeView (..), transparentTy,-                                              typeKind, tyView)+                                              typeKind, coreView) import           CLaSH.Core.Util             (Delta, Gamma, collectArgs,                                               mkAbstraction, mkApps, mkId,                                               mkLams, mkTmApps, mkTyApps,@@ -410,8 +410,8 @@ mkSelectorCase caller tcm _ scrut dcI fieldI = do   scrutTy <- termType tcm scrut   let cantCreate loc info = error $ loc ++ "Can't create selector " ++ show (caller,dcI,fieldI) ++ " for: (" ++ showDoc scrut ++ " :: " ++ showDoc scrutTy ++ ")\nAdditional info: " ++ info-  case transparentTy scrutTy of-    (tyView -> TyConApp tc args) ->+  case coreView tcm scrutTy of+    TyConApp tc args ->       case tyConDataCons (tcm HMS.! tc) of         [] -> cantCreate $(curLoc) ("TyCon has no DataCons: " ++ show tc ++ " " ++ showDoc tc)         dcs | dcI > length dcs -> cantCreate $(curLoc) "DC index exceeds max"@@ -427,7 +427,10 @@               let pat    = DataPat (embed dc) (rebind [] bndrs)               let retVal = Case scrut [ bind pat (snd selBndr) ]               return retVal-    _ -> cantCreate $(curLoc) "Type of subject is not a datatype"+    FunTy _ _ -> do+      (id_,var) <- mkInternalVar "selector" scrutTy+      return (mkLams var [id_])+    (OtherType oTy) -> cantCreate $(curLoc) ("Type of subject is not a datatype: " ++ showDoc oTy)  -- | Specialise an application on its argument specialise :: (Functor m, State.MonadState s m)