X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=VHDL.hs;h=adf1bf9694faa073f4944dd7c157254c7cb224de;hb=d704c6a23e75f563d4816a0e01219fa7a3be266c;hp=5f7face4a6b09735ab687ce28b381f8393ac80b0;hpb=e479bd172f803b7f75b0dc6b08d3d1792638a711;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/VHDL.hs b/VHDL.hs index 5f7face..adf1bf9 100644 --- a/VHDL.hs +++ b/VHDL.hs @@ -59,9 +59,13 @@ createEntity hsfunc fdata = in setEntity hsfunc entity' where - mkMap :: Eq id => [(id, SignalInfo)] -> id -> (AST.VHDLId, AST.TypeMark) + mkMap :: Eq id => [(id, SignalInfo)] -> id -> Maybe (AST.VHDLId, AST.TypeMark) mkMap sigmap id = - (mkVHDLId nm, vhdl_ty ty) + if isPortSigUse $ sigUse info + then + Just (mkVHDLId nm, vhdl_ty ty) + else + Nothing where info = Maybe.fromMaybe (error $ "Signal not found in the name map? This should not happen!") @@ -87,7 +91,7 @@ createEntityAST hsfunc args res = ++ clk_port mapToPorts :: AST.Mode -> VHDLSignalMap -> [AST.IfaceSigDec] mapToPorts mode m = - map (mkIfaceSigDec mode) (Foldable.toList m) + Maybe.catMaybes $ map (mkIfaceSigDec mode) (Foldable.toList m) -- Add a clk port if we have state clk_port = if hasState hsfunc then @@ -98,10 +102,11 @@ createEntityAST hsfunc args res = -- | Create a port declaration mkIfaceSigDec :: AST.Mode -- | The mode for the port (In / Out) - -> (AST.VHDLId, AST.TypeMark) -- | The id and type for the port - -> AST.IfaceSigDec -- | The resulting port declaration + -> Maybe (AST.VHDLId, AST.TypeMark) -- | The id and type for the port + -> Maybe AST.IfaceSigDec -- | The resulting port declaration -mkIfaceSigDec mode (id, ty) = AST.IfaceSigDec id mode ty +mkIfaceSigDec mode (Just (id, ty)) = Just $ AST.IfaceSigDec id mode ty +mkIfaceSigDec _ Nothing = Nothing -- | Generate a VHDL entity name for the given hsfunc mkEntityId hsfunc = @@ -124,22 +129,21 @@ createArchitecture hsfunc fdata = 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 :: (Int, SignalInfo, SignalInfo) -> AST.ProcSm +mkStateProcSm :: (StateId, SignalInfo, SignalInfo) -> AST.ProcSm mkStateProcSm (num, old, new) = AST.ProcSm label [clk] [statement] where @@ -169,14 +173,13 @@ getSignalId info = (error $ "Unnamed signal? This should not happen!") (sigName info) --- | Transforms a flat function application to a VHDL component instantiation. -mkCompInsSm :: - [(UnnamedSignal, SignalInfo)] -- | The signals in the current architecture - -> FApp UnnamedSignal -- | The application to look at. - -> VHDLState AST.CompInsSm -- | The corresponding VHDL component instantiation. +-- | Transforms a signal definition into a VHDL concurrent statement +mkConcSm :: + [(SignalId, SignalInfo)] -- | The signals in the current architecture + -> 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!") @@ -186,33 +189,42 @@ mkCompInsSm sigs app = do (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) + +mkConcSm sigs (UncondDef src dst) = do + let src_name = AST.NSimple (getSignalId $ signalInfo sigs src) + let src_expr = AST.PrimName src_name + let src_wform = AST.Wform [AST.WformElem src_expr Nothing] + let dst_name = AST.NSimple (getSignalId $ signalInfo sigs dst) + let assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing) + return $ AST.CSSASm assign mkAssocElems :: - [(UnnamedSignal, SignalInfo)] -- | The signals in the current architecture - -> FApp UnnamedSignal -- | 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 - zipWith mkAssocElem ports sigs + Maybe.catMaybes $ zipWith mkAssocElem ports sigs where -- Turn the ports and signals from a map into a flat list. This works, -- since the maps must have an identical form by definition. TODO: Check -- 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 fst (arg_ports ++ res_ports)) + ports = (map (fmap fst) (arg_ports ++ res_ports)) -- Translate signal numbers into names sigs = (map (lookupSigName sigmap) (arg_sigs ++ res_sigs)) -- | Look up a signal in the signal name map -lookupSigName :: [(UnnamedSignal, SignalInfo)] -> UnnamedSignal -> String +lookupSigName :: [(SignalId, SignalInfo)] -> SignalId -> String lookupSigName sigs sig = name where info = Maybe.fromMaybe @@ -223,8 +235,9 @@ lookupSigName sigs sig = name (sigName info) -- | Create an VHDL port -> signal association -mkAssocElem :: AST.VHDLId -> String -> AST.AssocElem -mkAssocElem port signal = Just port AST.:=>: (AST.ADName (AST.NSimple (mkVHDLId signal))) +mkAssocElem :: Maybe AST.VHDLId -> String -> Maybe AST.AssocElem +mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NSimple (mkVHDLId signal))) +mkAssocElem Nothing _ = Nothing -- | Extracts the generated entity id from the given funcdata getEntityId :: FuncData -> Maybe AST.VHDLId