clash-ghc 0.5.13 → 0.5.14
raw patch · 4 files changed
+59/−28 lines, 4 filesdep ~clash-libdep ~clash-systemverilogdep ~clash-verilog
Dependency ranges changed: clash-lib, clash-systemverilog, clash-verilog, clash-vhdl
Files
- CHANGELOG.md +12/−0
- clash-ghc.cabal +5/−5
- src-ghc/CLaSH/GHC/Evaluator.hs +41/−21
- src-ghc/CLaSH/GHC/GHC2Core.hs +1/−2
CHANGELOG.md view
@@ -1,5 +1,17 @@ # Changelog for the [`clash-ghc`](http://hackage.haskell.org/package/clash-ghc) package +## 0.5.14 *September 14th 2015*+* New features:+ * Completely unroll "definitions" of some higher-order primitives with non-representable argument or result vectors:+ It is now possible to translate e.g. `f xs ys = zipWith ($) (map (+) xs) ys :: Vec 4 Int -> Vec 4 Int -> Vec 4 Int`++* Fixes bugs:+ * Converting Bool to Unsigned generates broken VHDL [#77](https://github.com/clash-lang/clash-compiler/issues/77)+ * `topLet` transformation erroneously not performed in a top-down traversal+ * Specialisation limit unchecked on types and constants+ * Vector of functions cannot be translated [#25](https://github.com/clash-lang/clash-compiler/issues/25 )+ * CLaSH fails to generate VHDL when map is applied [#78](https://github.com/clash-lang/clash-compiler/issues/78)+ ## 0.5.13 *September 8th 2015* * Fixes bugs: * Cannot translate GHC `MachLabel` literal
clash-ghc.cabal view
@@ -1,5 +1,5 @@ Name: clash-ghc-Version: 0.5.13+Version: 0.5.14 Synopsis: CAES Language for Synchronous Hardware Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -94,10 +94,10 @@ unbound-generics >= 0.1 && < 0.3, unordered-containers >= 0.2.1.0, - clash-lib >= 0.5.11 && < 0.6,- clash-systemverilog >= 0.5.8,- clash-vhdl >= 0.5.10,- clash-verilog >= 0.5.8,+ clash-lib >= 0.5.12 && < 0.6,+ clash-systemverilog >= 0.5.9,+ clash-vhdl >= 0.5.11,+ clash-verilog >= 0.5.9, clash-prelude >= 0.9.2, ghc-typelits-natnormalise >= 0.3
src-ghc/CLaSH/GHC/Evaluator.hs view
@@ -7,55 +7,57 @@ import qualified Data.Either as Either import qualified Data.HashMap.Strict as HashMap import qualified Data.List as List-import Unbound.Generics.LocallyNameless (bind, embed, string2Name)+import Unbound.Generics.LocallyNameless (runFreshM, bind, embed,+ string2Name) import CLaSH.Core.DataCon (DataCon (..)) import CLaSH.Core.Literal (Literal (..)) import CLaSH.Core.Term (Term (..))-import CLaSH.Core.Type (Type (..), ConstTy (..), mkFunTy)+import CLaSH.Core.Type (Type (..), ConstTy (..), LitTy (..),+ TypeView (..), tyView, mkFunTy) import CLaSH.Core.TyCon (TyCon, TyConName, tyConDataCons) import CLaSH.Core.TysPrim (typeNatKind)-import CLaSH.Core.Util (collectArgs, mkApps)+import CLaSH.Core.Util (collectArgs,mkApps,mkVec,termType) import CLaSH.Core.Var (Var (..)) -reduceConstant :: HashMap.HashMap TyConName TyCon -> Term -> Term-reduceConstant tcm e@(collectArgs -> (Prim nm _, args))+reduceConstant :: HashMap.HashMap TyConName TyCon -> Bool -> Term -> Term+reduceConstant tcm isSubj e@(collectArgs -> (Prim nm _, args)) | nm == "GHC.Prim.==#" || nm == "GHC.Integer.Type.eqInteger#"- = case (map (reduceConstant tcm) . Either.lefts) args of+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] | i == j -> Literal (IntegerLiteral 1) | otherwise -> Literal (IntegerLiteral 0) _ -> e | nm == "GHC.Prim.>#" || nm == "GHC.Integer.Type.gtInteger#"- = case (map (reduceConstant tcm) . Either.lefts) args of+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] | i > j -> Literal (IntegerLiteral 1) | otherwise -> Literal (IntegerLiteral 0) _ -> e | nm == "GHC.Prim.<#" || nm == "GHC.Integer.Type.ltInteger#"- = case (map (reduceConstant tcm) . Either.lefts) args of+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] | i < j -> Literal (IntegerLiteral 1) | otherwise -> Literal (IntegerLiteral 0) _ -> e | nm == "GHC.Prim.<=#" || nm == "GHC.Integer.Type.leInteger#"- = case (map (reduceConstant tcm) . Either.lefts) args of+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] | i <= j -> Literal (IntegerLiteral 1) | otherwise -> Literal (IntegerLiteral 0) _ -> e | nm == "GHC.Prim.>=#" || nm == "GHC.Integer.Type.geInteger#"- = case (map (reduceConstant tcm) . Either.lefts) args of+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] | i >= j -> Literal (IntegerLiteral 1) | otherwise -> Literal (IntegerLiteral 0) _ -> e | nm == "GHC.Integer.Type.integerToInt"- = case (map (reduceConstant tcm) . Either.lefts) args of+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i)] -> Literal (IntegerLiteral i) _ -> e | nm == "GHC.Prim.tagToEnum#"- = case map (Bifunctor.bimap (reduceConstant tcm) id) args of+ = case map (Bifunctor.bimap (reduceConstant tcm isSubj) id) args of [Right (ConstTy (TyCon tcN)), Left (Literal (IntegerLiteral i))] -> let dc = do { tc <- HashMap.lookup tcN tcm ; let dcs = tyConDataCons tc@@ -64,32 +66,42 @@ in maybe e Data dc _ -> e | nm == "GHC.Prim.*#"- = case (map (reduceConstant tcm) . Either.lefts) args of+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] -> Literal (IntegerLiteral (i * j)) _ -> e | nm == "GHC.Integer.Type.minusInteger"- = case (map (reduceConstant tcm) . Either.lefts) args of+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] -> Literal (IntegerLiteral (i - j)) _ -> e | nm == "GHC.Integer.Type.divInteger"- = case (map (reduceConstant tcm) . Either.lefts) args of+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] -> Literal (IntegerLiteral (i `div` j)) _ -> e+ | nm == "GHC.Integer.Type.quotInteger"+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of+ [Literal (IntegerLiteral i), Literal (IntegerLiteral j)]+ -> Literal (IntegerLiteral (i `quot` j))+ _ -> e+ | nm == "GHC.Integer.Type.remInteger"+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of+ [Literal (IntegerLiteral i), Literal (IntegerLiteral j)]+ -> Literal (IntegerLiteral (i `rem` j))+ _ -> e | nm == "GHC.Integer.Type.shiftLInteger"- = case (map (reduceConstant tcm) . Either.lefts) args of+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] -> Literal (IntegerLiteral (i `shiftL` fromInteger j)) _ -> e | nm == "GHC.Integer.Type.shiftRInteger"- = case (map (reduceConstant tcm) . Either.lefts) args of+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i), Literal (IntegerLiteral j)] -> Literal (IntegerLiteral (i `shiftR` fromInteger j)) _ -> e | nm == "GHC.Prim.negateInt#"- = case (map (reduceConstant tcm) . Either.lefts) args of+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i)] -> Literal (IntegerLiteral (negate i)) _ -> e | nm == "CLaSH.Sized.Internal.Signed.minBound#"@@ -116,20 +128,28 @@ in mkApps unsignedConPrim [litTy,Left (Literal (IntegerLiteral maxB))] _ -> e | nm == "CLaSH.Sized.Internal.Signed.toInteger#" || nm == "CLaSH.Sized.Internal.Unsigned.toInteger#"- = case (map (reduceConstant tcm) . Either.lefts) args of+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [App _ (Literal (IntegerLiteral i))] -> Literal (IntegerLiteral i) _ -> e | nm == "GHC.TypeLits.natVal"- = case (map (reduceConstant tcm) . Either.lefts) args of+ = case (map (reduceConstant tcm isSubj) . Either.lefts) args of [Literal (IntegerLiteral i), _] -> Literal (IntegerLiteral i) _ -> e | nm == "CLaSH.Promoted.Nat.SNat" = case (map collectArgs . Either.lefts) args of [(Literal (IntegerLiteral _),[]), (Data _,_)] -> mkApps snatCon args _ -> e+ | isSubj && nm == "CLaSH.Sized.Vector.replicate"+ = let ty = runFreshM (termType tcm e)+ in case tyView ty of+ (TyConApp vecTcNm [LitTy (NumTy len),argTy]) ->+ let (Just vecTc) = HashMap.lookup vecTcNm tcm+ [nilCon,consCon] = tyConDataCons vecTc+ in mkVec nilCon consCon argTy len (replicate len (last $ Either.lefts args))+ _ -> e -reduceConstant _ e = e+reduceConstant _ _ e = e signedConPrim :: Term signedConPrim = Prim "CLaSH.Sized.Internal.Signed.S" (ForAllTy (bind nTV funTy))
src-ghc/CLaSH/GHC/GHC2Core.hs view
@@ -55,8 +55,7 @@ import Name (Name, nameModule_maybe, nameOccName, nameUnique) import OccName (occNameString)-import Outputable (showPpr, showSDoc)-import PprCore (pprCoreExpr)+import Outputable (showPpr) import TyCon (AlgTyConRhs (..), TyCon, algTyConRhs, isAlgTyCon, isFamilyTyCon, isFunTyCon, isNewTyCon,