module Constants where
-import qualified ForSyDe.Backend.VHDL.AST as AST
+import qualified Language.VHDL.AST as AST
--------------
-- Identifiers
deriving instance (Show b) => Show (CoreSyn.Bind b)
deriving instance Show TypeRep.Type
deriving instance (Show n, OutputableBndr n) => Show (HsTypes.HsType n)
+deriving instance (Show n, OutputableBndr n) => Show (HsTypes.ConDeclField n)
deriving instance (Show x) => Show (SrcLoc.Located x)
deriving instance (Show x, OutputableBndr x) => Show (HsExpr.StmtLR x x)
deriving instance (Show x, OutputableBndr x) => Show (HsExpr.HsExpr x)
import Debug.Trace
-- ForSyDe
-import qualified ForSyDe.Backend.VHDL.AST as AST
+import qualified Language.VHDL.AST as AST
-- GHC API
import CoreSyn
-> [Either CoreSyn.CoreExpr AST.Expr] -- ^ The arguments to apply
-> VHDLSession [AST.ConcSm] -- ^ The resulting concurrent statements
genApplication dst f args = do
- case Var.globalIdVarDetails f of
- IdInfo.DataConWorkId dc -> case dst of
- -- It's a datacon. Create a record from its arguments.
- Left bndr -> do
- -- We have the bndr, so we can get at the type
- labels <- MonadState.lift vsType $ getFieldLabels (Var.varType bndr)
- args' <- eitherCoreOrExprArgs args
- return $ zipWith mkassign labels $ args'
- where
- mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
- mkassign label arg =
- let sel_name = mkSelectedName ((either varToVHDLName id) dst) label in
- mkUncondAssign (Right sel_name) arg
- Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconstructor application without an original binder"
- IdInfo.VanillaGlobal -> do
- -- It's a global value imported from elsewhere. These can be builtin
- -- functions. Look up the function name in the name table and execute
- -- the associated builder if there is any and the argument count matches
- -- (this should always be the case if it typechecks, but just to be
- -- sure...).
- case (Map.lookup (varToString f) globalNameTable) of
- Just (arg_count, builder) ->
- if length args == arg_count then
- builder dst f args
- else
- error $ "\nGenerate.genApplication(VanillaGlobal): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
- Nothing -> error $ "\nGenerate.genApplication(VanillaGlobal): Using function from another module that is not a known builtin: " ++ pprString f
- IdInfo.NotGlobalId -> do
+ case Var.isGlobalId f of
+ False -> do
signatures <- getA vsSignatures
-- This is a local id, so it should be a function whose definition we
-- have and which can be turned into a component instantiation.
-- unconditional assignment here.
f' <- MonadState.lift vsType $ varToVHDLExpr f
return $ [mkUncondAssign dst f']
-
- IdInfo.ClassOpId cls -> do
- -- FIXME: Not looking for what instance this class op is called for
- -- Is quite stupid of course.
- case (Map.lookup (varToString f) globalNameTable) of
- Just (arg_count, builder) ->
- if length args == arg_count then
- builder dst f args
- else
- error $ "\nGenerate.genApplication(ClassOpId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
- Nothing -> error $ "\nGenerate.genApplication(ClassOpId): Using function from another module that is not a known builtin: " ++ pprString f
- details -> error $ "\nGenerate.genApplication: Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details
+ True ->
+ case Var.idDetails f of
+ IdInfo.DataConWorkId dc -> case dst of
+ -- It's a datacon. Create a record from its arguments.
+ Left bndr -> do
+ -- We have the bndr, so we can get at the type
+ labels <- MonadState.lift vsType $ getFieldLabels (Var.varType bndr)
+ args' <- eitherCoreOrExprArgs args
+ return $ zipWith mkassign labels $ args'
+ where
+ mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
+ mkassign label arg =
+ let sel_name = mkSelectedName ((either varToVHDLName id) dst) label in
+ mkUncondAssign (Right sel_name) arg
+ Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconstructor application without an original binder"
+ IdInfo.VanillaId -> do
+ -- It's a global value imported from elsewhere. These can be builtin
+ -- functions. Look up the function name in the name table and execute
+ -- the associated builder if there is any and the argument count matches
+ -- (this should always be the case if it typechecks, but just to be
+ -- sure...).
+ case (Map.lookup (varToString f) globalNameTable) of
+ Just (arg_count, builder) ->
+ if length args == arg_count then
+ builder dst f args
+ else
+ error $ "\nGenerate.genApplication(VanillaGlobal): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
+ Nothing -> error $ "\nGenerate.genApplication(VanillaGlobal): Using function from another module that is not a known builtin: " ++ pprString f
+ IdInfo.ClassOpId cls -> do
+ -- FIXME: Not looking for what instance this class op is called for
+ -- Is quite stupid of course.
+ case (Map.lookup (varToString f) globalNameTable) of
+ Just (arg_count, builder) ->
+ if length args == arg_count then
+ builder dst f args
+ else
+ error $ "\nGenerate.genApplication(ClassOpId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
+ Nothing -> error $ "\nGenerate.genApplication(ClassOpId): Using function from another module that is not a known builtin: " ++ pprString f
+ details -> error $ "\nGenerate.genApplication: Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details
-----------------------------------------------------------------------------
-- Functions to generate functions dealing with vectors.
if null bindings || length alts == 1 && length bindings == 1 then return expr else change newlet
where
-- Generate a single wild binder, since they are all the same
- wild = Id.mkWildId
+ wild = MkCore.mkWildBinder
-- Wilden the binders of one alt, producing a list of bindings as a
-- sideeffect.
doalt :: CoreAlt -> TransformMonad ([(CoreBndr, CoreExpr)], CoreAlt)
return (bindings, newalt)
where
-- Make all binders wild
- wildbndrs = map (\bndr -> Id.mkWildId (Id.idType bndr)) bndrs
+ wildbndrs = map (\bndr -> MkCore.mkWildBinder (Id.idType bndr)) bndrs
-- A set of all the binders that are used by the expression
free_vars = CoreFVs.exprSomeFreeVars (`elem` bndrs) expr
-- Creates a case statement to retrieve the ith element from the scrutinee
normalizeBind bndr =
-- Don't normalize global variables, these should be either builtin
-- functions or data constructors.
- Monad.when (Var.isLocalIdVar bndr) $ do
+ Monad.when (Var.isLocalId bndr) $ do
-- Skip binders that have a polymorphic type, since it's impossible to
-- create polymorphic hardware.
if is_poly (Var bndr)
uniq <- mkUnique
let occname = OccName.mkVarOcc (str ++ show uniq)
let name = Name.mkInternalName uniq occname SrcLoc.noSrcSpan
- return $ Var.mkLocalIdVar name ty IdInfo.vanillaIdInfo
+ return $ Var.mkLocalVar IdInfo.VanillaId name ty IdInfo.vanillaIdInfo
-- Create a new type variable with the given name and kind. A Unique is
-- appended to the given name, to ensure uniqueness (not strictly neccesary,
uniq <- mkUnique
-- Swap out the unique, and reset the IdInfo (I'm not 100% sure what it
-- contains, but vannillaIdInfo is always correct, since it means "no info").
- return $ Var.lazySetVarIdInfo (Var.setVarUnique v uniq) IdInfo.vanillaIdInfo
+ return $ Var.lazySetIdInfo (Var.setVarUnique v uniq) IdInfo.vanillaIdInfo
-- Creates a new function with the same name as the given binder (but with a
-- new unique) and with the given function body. Returns the new binder for
import Text.PrettyPrint.HughesPJClass
import Outputable ( showSDoc, showSDocDebug, ppr, Outputable, OutputableBndr)
-import qualified ForSyDe.Backend.Ppr
-import qualified ForSyDe.Backend.VHDL.Ppr
-import qualified ForSyDe.Backend.VHDL.AST as AST
+import qualified Language.VHDL.Ppr as Ppr
+import qualified Language.VHDL.AST as AST
+import qualified Language.VHDL.AST.Ppr
import HsValueMap
import FlattenTypes
pPrint = text . show
instance Pretty AST.VHDLId where
- pPrint id = ForSyDe.Backend.Ppr.ppr id
+ pPrint id = Ppr.ppr id
instance Pretty AST.VHDLName where
- pPrint name = ForSyDe.Backend.Ppr.ppr name
+ pPrint name = Ppr.ppr name
prettyBind :: (Show b, Show e) => (b, e) -> Doc
prettyBind (b, expr) =
-- The following modules come from the ForSyDe project. They are really
-- internal modules, so ForSyDe.cabal has to be modified prior to installing
-- ForSyDe to get access to these modules.
-import qualified ForSyDe.Backend.VHDL.AST as AST
-import qualified ForSyDe.Backend.VHDL.Ppr
-import qualified ForSyDe.Backend.VHDL.FileIO
-import qualified ForSyDe.Backend.Ppr
+import qualified Language.VHDL.AST as AST
+import qualified Language.VHDL.FileIO
+import qualified Language.VHDL.Ppr as Ppr
-- This is needed for rendering the pretty printed VHDL
import Text.PrettyPrint.HughesPJ (render)
let all_bindings = (CoreSyn.flattenBinds $ cm_binds core)
let (normalized_bindings, typestate) = normalizeModule env uniqSupply all_bindings binds statefuls
let vhdl = VHDL.createDesignFiles typestate normalized_bindings
- mapM (putStr . render . ForSyDe.Backend.Ppr.ppr . snd) vhdl
+ mapM (putStr . render . Ppr.ppr . snd) vhdl
--putStr $ "\n\nFinal session:\n" ++ prettyShow sess ++ "\n\n"
return vhdl
where
-- Find the filename
let fname = dir ++ (AST.fromVHDLId name) ++ ".vhdl"
-- Write the file
- ForSyDe.Backend.VHDL.FileIO.writeDesignFile vhdl fname
+ Language.VHDL.FileIO.writeDesignFile vhdl fname
-- | Loads the given file and turns it into a core module.
loadModule :: String -> IO (HscTypes.CoreModule, HscTypes.HscEnv)
import qualified HscTypes
-import qualified ForSyDe.Backend.VHDL.AST as AST
+import qualified Language.VHDL.AST as AST
import FlattenTypes
import VHDLTypes
import Debug.Trace
-- ForSyDe
-import qualified ForSyDe.Backend.VHDL.AST as AST
+import qualified Language.VHDL.AST as AST
-- GHC API
import CoreSyn
import Debug.Trace
-- ForSyDe
-import qualified ForSyDe.Backend.VHDL.AST as AST
+import qualified Language.VHDL.AST as AST
-- GHC API
import CoreSyn
import qualified HscTypes
-- ForSyDe imports
-import qualified ForSyDe.Backend.VHDL.AST as AST
+import qualified Language.VHDL.AST as AST
-- Local imports
version: 0.1
build-type: Simple
synopsis: CAES Languege for Hardware Descriptions (CλasH)
-description: CλasH is a toolchain/language to translate subsets of Haskell to synthesizable VHDL. It does this by translating the intermediate System Fc (GHC Core) representation to a VHDL AST, which is then written to file.
+description: CλasH is a toolchain/language to translate subsets of
+ Haskell to synthesizable VHDL. It does this by
+ translating the intermediate System Fc (GHC Core)
+ representation to a VHDL AST, which is then written to
+ file.
category: Development
license: BSD3
license-file: LICENSE
author: Christiaan Baaij & Matthijs Kooijman
stability: alpha
maintainer: christiaan.baaij@gmail.com & matthijs@stdin.nl
-build-depends: base > 4, syb, ghc, ghc-paths, transformers, haskell98,
- ForSyDe > 3.0, regex-posix ,data-accessor-template, pretty,
- data-accessor, containers, prettyclass, tfp > 0.3.2,
- tfvec > 0.1.2, QuickCheck, template-haskell, filepath
+build-depends: ghc >= 6.11, vhdl, data-accessor-template, data-accessor,
+ containers, transformers, base >= 4, haskell98,
+ prettyclass, ghc-paths, pretty, syb, filepath,
+ th-lift-ng, tfp > 0.3.2, tfvec > 0.1.2
executable: clash
-main-is: Main.hs
-ghc-options:
+main-is: Main.hs
projects / matthijs / master-project / cλash.git / commitdiff