flattenFunction _ (Rec _) = error "Recursive binders not supported"
flattenFunction hsfunc bind@(NonRec var expr) =
- FlatFunction args res apps conds sigs''''
+ FlatFunction args res defs sigs''''
where
- init_state = ([], [], [], 0)
+ init_state = ([], [], 0)
(fres, end_state) = State.runState (flattenExpr [] expr) init_state
- (apps, conds, sigs, _) = end_state
+ (defs, sigs, _) = end_state
(args, res) = fres
arg_ports = concat (map Foldable.toList args)
res_ports = Foldable.toList res
appArgs = arg_ress,
appRes = res
}
- addApp app
+ addDef app
return ([], res)
-- | Check a flattened expression to see if it is valid to use as a
-- function argument. The first argument is the original expression for
any (Foldable.any isStateUse) (hsFuncArgs hsfunc)
|| Foldable.any isStateUse (hsFuncRes hsfunc)
--- | A flattened function application
-data FApp = FApp {
- appFunc :: HsFunction,
- appArgs :: [SignalMap],
- appRes :: SignalMap
-} deriving (Show, Eq)
-
--- | A conditional signal definition
-data CondDef = CondDef {
- cond :: SignalId,
- high :: SignalId,
- low :: SignalId,
- condRes :: SignalId
-} deriving (Show, Eq)
+-- | Something that defines a signal
+data SigDef =
+ -- | A flattened function application
+ FApp {
+ appFunc :: HsFunction,
+ appArgs :: [SignalMap],
+ appRes :: SignalMap
+ }
+ -- | A conditional signal definition
+ | CondDef {
+ cond :: SignalId,
+ high :: SignalId,
+ low :: SignalId,
+ condRes :: SignalId
+ }
+ -- | Unconditional signal definition
+ | UncondDef {
+ defSrc :: SignalId,
+ defDst :: SignalId
+ } deriving (Show, Eq)
+
+-- Returns the function used by the given SigDef, if any
+usedHsFunc :: SigDef -> Maybe HsFunction
+usedHsFunc (FApp hsfunc _ _) = Just hsfunc
+usedHsFunc _ = Nothing
-- | How is a given signal used in the resulting VHDL?
data SigUse =
data FlatFunction = FlatFunction {
flat_args :: [SignalMap],
flat_res :: SignalMap,
- flat_apps :: [FApp],
- flat_conds :: [CondDef],
+ flat_defs :: [SigDef],
flat_sigs :: [(SignalId, SignalInfo)]
}
)]
-- | The state during the flattening of a single function
-type FlattenState = State.State ([FApp], [CondDef], [(SignalId, SignalInfo)], SignalId)
+type FlattenState = State.State ([SigDef], [(SignalId, SignalInfo)], SignalId)
-- | Add an application to the current FlattenState
-addApp :: (FApp) -> FlattenState ()
-addApp a = do
- (apps, conds, sigs, n) <- State.get
- State.put (a:apps, conds, sigs, n)
-
--- | Add a conditional definition to the current FlattenState
-addCondDef :: (CondDef) -> FlattenState ()
-addCondDef c = do
- (apps, conds, sigs, n) <- State.get
- State.put (apps, c:conds, sigs, n)
+addDef :: SigDef -> FlattenState ()
+addDef d = do
+ (defs, sigs, n) <- State.get
+ State.put (d:defs, sigs, n)
-- | Generates a new signal id, which is unique within the current flattening.
genSignalId :: SigUse -> Type.Type -> FlattenState SignalId
genSignalId use ty = do
- (apps, conds, sigs, n) <- State.get
+ (defs, sigs, n) <- State.get
-- Generate a new numbered but unnamed signal
let s = (n, SignalInfo Nothing use ty)
- State.put (apps, conds, s:sigs, n+1)
+ State.put (defs, s:sigs, n+1)
return n
pPrint (HighOrder _ _) = text "Higher Order"
instance Pretty FlatFunction where
- pPrint (FlatFunction args res apps conds sigs) =
+ pPrint (FlatFunction args res defs sigs) =
(text "Args: ") $$ nest 10 (pPrint args)
$+$ (text "Result: ") $$ nest 10 (pPrint res)
- $+$ (text "Apps: ") $$ nest 10 (vcat (map pPrint apps))
- $+$ (text "Conds: ") $$ nest 10 (pPrint conds)
+ $+$ (text "Defs: ") $$ nest 10 (pPrint defs)
$+$ text "Signals: " $$ nest 10 (printList ppsig sigs)
where
ppsig (id, info) = pPrint id <> pPrint info
-instance Pretty FApp where
+instance Pretty SigDef where
pPrint (FApp func args res) =
pPrint func <> text " : " <> pPrint args <> text " -> " <> pPrint res
-
-instance Pretty CondDef where
- pPrint _ = text "TODO"
+ pPrint (CondDef _ _ _ _) = text "TODO"
+ pPrint (UncondDef src dst) = text "TODO"
instance Pretty SignalInfo where
pPrint (SignalInfo name use ty) =
--core <- GHC.compileToCoreSimplified "Adders.hs"
core <- GHC.compileToCoreSimplified "Adders.hs"
--liftIO $ printBinds (cm_binds core)
- let binds = Maybe.mapMaybe (findBind (cm_binds core)) ["dff"]
+ let binds = Maybe.mapMaybe (findBind (cm_binds core)) ["sfull_adder"]
liftIO $ putStr $ prettyShow binds
-- Turn bind into VHDL
let (vhdl, sess) = State.runState (mkVHDL binds) (VHDLSession core 0 Map.empty)
let flatfunc = flattenFunction hsfunc bind
addFunc hsfunc
setFlatFunc hsfunc flatfunc
- let used_hsfuncs = map appFunc (flat_apps flatfunc)
+ let used_hsfuncs = Maybe.mapMaybe usedHsFunc (flat_defs flatfunc)
State.mapM resolvFunc used_hsfuncs
return ()
let sigs = flat_sigs flatfunc
let args = flat_args flatfunc
let res = flat_res flatfunc
- let apps = flat_apps flatfunc
+ let defs = flat_defs flatfunc
let entity_id = Maybe.fromMaybe
(error $ "Building architecture without an entity? This should not happen!")
(getEntityId fdata)
-- Create signal declarations for all signals that are not in args and
-- res
let sig_decs = Maybe.catMaybes $ map (mkSigDec . snd) sigs
- -- Create component instantiations for all function applications
- insts <- mapM (mkCompInsSm sigs) apps
+ -- Create concurrent statements for all signal definitions
+ statements <- mapM (mkConcSm sigs) defs
let procs = map mkStateProcSm (getOwnStates hsfunc flatfunc)
- let insts' = map AST.CSISm insts
let procs' = map AST.CSPSm procs
- let arch = AST.ArchBody (mkVHDLId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) (insts' ++ procs')
+ let arch = AST.ArchBody (mkVHDLId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) (statements ++ procs')
setArchitecture hsfunc arch
mkStateProcSm :: (StateId, SignalInfo, SignalInfo) -> AST.ProcSm
(error $ "Unnamed signal? This should not happen!")
(sigName info)
--- | Transforms a flat function application to a VHDL component instantiation.
-mkCompInsSm ::
+-- | Transforms a signal definition into a VHDL concurrent statement
+mkConcSm ::
[(SignalId, SignalInfo)] -- | The signals in the current architecture
- -> FApp -- | The application to look at.
- -> VHDLState AST.CompInsSm -- | The corresponding VHDL component instantiation.
+ -> SigDef -- | The signal definition
+ -> VHDLState AST.ConcSm -- | The corresponding VHDL component instantiation.
-mkCompInsSm sigs app = do
- let hsfunc = appFunc app
+mkConcSm sigs (FApp hsfunc args res) = do
fdata_maybe <- getFunc hsfunc
let fdata = Maybe.fromMaybe
(error $ "Using function '" ++ (prettyShow hsfunc) ++ "' that is not in the session? This should not happen!")
(funcEntity fdata)
let entity_id = ent_id entity
label <- uniqueName (AST.fromVHDLId entity_id)
- let portmaps = mkAssocElems sigs app entity
- return $ AST.CompInsSm (mkVHDLId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
+ let portmaps = mkAssocElems sigs args res entity
+ return $ AST.CSISm $ AST.CompInsSm (mkVHDLId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
mkAssocElems ::
- [(SignalId, SignalInfo)] -- | The signals in the current architecture
- -> FApp -- | The application to look at.
+ [(SignalId, SignalInfo)] -- | The signals in the current architecture
+ -> [SignalMap] -- | The signals that are applied to function
+ -> SignalMap -- | the signals in which to store the function result
-> Entity -- | The entity to map against.
-> [AST.AssocElem] -- | The resulting port maps
-mkAssocElems sigmap app entity =
+mkAssocElems sigmap args res entity =
-- Create the actual AssocElems
Maybe.catMaybes $ zipWith mkAssocElem ports sigs
where
-- the similar form?
arg_ports = concat (map Foldable.toList (ent_args entity))
res_ports = Foldable.toList (ent_res entity)
- arg_sigs = (concat (map Foldable.toList (appArgs app)))
- res_sigs = Foldable.toList (appRes app)
+ arg_sigs = (concat (map Foldable.toList args))
+ res_sigs = Foldable.toList res
-- Extract the id part from the (id, type) tuple
ports = (map (fmap fst) (arg_ports ++ res_ports))
-- Translate signal numbers into names
projects / matthijs / master-project / cλash.git / commitdiff