import qualified Control.Monad.Trans.State as State
import qualified Data.Monoid as Monoid
import Data.Accessor
-import Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad.Trans.State as MonadState
import Debug.Trace
-- ForSyDe
-- ^ The id and content of the types package
createTypesPackage = do
- tyfuns <- getA (tsType .> tsTypeFuns)
+ tyfuns <- MonadState.get (tsType .> tsTypeFuns)
let tyfun_decls = mkBuiltInShow ++ (map snd $ Map.elems tyfuns)
- ty_decls <- getA (tsType .> tsTypeDecls)
+ ty_decls_maybes <- MonadState.get (tsType .> tsTypeDecls)
+ let ty_decls = Maybe.catMaybes ty_decls_maybes
let subProgSpecs = map (\(AST.SubProgBody spec _ _) -> AST.PDISS spec) tyfun_decls
let type_package_dec = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") ([tfvec_index_decl] ++ ty_decls ++ subProgSpecs)
let type_package_body = AST.LUPackageBody $ AST.PackageBody typesId tyfun_decls
entity <- getEntity bndr
(arch, _) <- getArchitecture bndr
return (ent_id entity, [AST.LUEntity (ent_dec entity), AST.LUArch arch])
-
-{-
--- | Looks up all pairs of old state, new state signals, together with
--- the state id they represent.
-makeStatePairs :: FlatFunction -> [(StateId, SignalInfo, SignalInfo)]
-makeStatePairs flatfunc =
- [(Maybe.fromJust $ oldStateId $ sigUse old_info, old_info, new_info)
- | old_info <- map snd (flat_sigs flatfunc)
- , new_info <- map snd (flat_sigs flatfunc)
- -- old_info must be an old state (and, because of the next equality,
- -- new_info must be a new state).
- , Maybe.isJust $ oldStateId $ sigUse old_info
- -- And the state numbers must match
- , (oldStateId $ sigUse old_info) == (newStateId $ sigUse new_info)]
-
- -- Replace the second tuple element with the corresponding SignalInfo
- --args_states = map (Arrow.second $ signalInfo sigs) args
-mkStateProcSm :: (StateId, SignalInfo, SignalInfo) -> AST.ProcSm
-mkStateProcSm (num, old, new) =
- AST.ProcSm label [clk] [statement]
- where
- label = mkVHDLExtId $ "state_" ++ (show num)
- clk = mkVHDLExtId "clk"
- rising_edge = AST.NSimple $ mkVHDLBasicId "rising_edge"
- wform = AST.Wform [AST.WformElem (AST.PrimName $ AST.NSimple $ getSignalId new) Nothing]
- assign = AST.SigAssign (AST.NSimple $ getSignalId old) wform
- rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clk)]
- statement = AST.IfSm rising_edge_clk [assign] [] Nothing
-
--- | Creates a VHDL Id from a named SignalInfo. Errors out if the SignalInfo
--- is not named.
-getSignalId :: SignalInfo -> AST.VHDLId
-getSignalId info =
- mkVHDLExtId $ Maybe.fromMaybe
- (error $ "Unnamed signal? This should not happen!")
- (sigName info)
--}