X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL.hs;h=56342fc2ce7df52d35d1caef448fea5381282ee4;hb=75978cf28a619d14ae27ea2bb4a53246b6a0bcd8;hp=5465df1663b3dcfd619097d14570f109e570be1f;hpb=a8bd9c0833fcf1212f5843b9db6c754cd1086353;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git "a/c\316\273ash/CLasH/VHDL.hs" "b/c\316\273ash/CLasH/VHDL.hs"
index 5465df1..56342fc 100644
--- "a/c\316\273ash/CLasH/VHDL.hs"
+++ "b/c\316\273ash/CLasH/VHDL.hs"
@@ -6,38 +6,22 @@ module CLasH.VHDL where
 -- Standard modules
 import qualified Data.Map as Map
 import qualified Maybe
-import qualified Control.Monad as Monad
 import qualified Control.Arrow as Arrow
-import qualified Control.Monad.Trans.State as State
-import qualified Data.Monoid as Monoid
 import Data.Accessor
-import Data.Accessor.MonadState as MonadState
-import Debug.Trace
+import qualified Data.Accessor.Monad.Trans.State as MonadState
 
--- ForSyDe
+-- VHDL Imports
 import qualified Language.VHDL.AST as AST
 
 -- GHC API
-import CoreSyn
---import qualified Type
-import qualified Name
-import qualified Var
-import qualified IdInfo
-import qualified TyCon
-import qualified DataCon
---import qualified CoreSubst
-import qualified CoreUtils
-import Outputable ( showSDoc, ppr )
+import qualified CoreSyn
 
 -- Local imports
 import CLasH.Translator.TranslatorTypes
 import CLasH.VHDL.VHDLTypes
 import CLasH.VHDL.VHDLTools
-import CLasH.Utils.Pretty
-import CLasH.Utils.Core.CoreTools
 import CLasH.VHDL.Constants
 import CLasH.VHDL.Generate
-import CLasH.VHDL.Testbench
 
 createDesignFiles ::
   [CoreSyn.CoreBndr] -- ^ Top binders
@@ -82,16 +66,17 @@ createTypesPackage ::
   -- ^ The id and content of the types package
  
 createTypesPackage = do
-  tyfuns <- getA (tsType .> tsTypeFuns)
-  let tyfun_decls = mkBuiltInShow ++ (map snd $ Map.elems tyfuns)
-  ty_decls <- getA (tsType .> tsTypeDecls)
+  tyfuns <- MonadState.get (tsType .> tsTypeFuns)
+  let tyfun_decls = mkBuiltInShow ++ map snd (Map.elems tyfuns)
+  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
-  return $ (mkVHDLBasicId "types", AST.DesignFile ieee_context [type_package_dec, type_package_body])
+  return (mkVHDLBasicId "types", AST.DesignFile ieee_context [type_package_dec, type_package_body])
   where
     tfvec_index_decl = AST.PDISD $ AST.SubtypeDec tfvec_indexTM tfvec_index_def
-    tfvec_range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit "-1") (AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerTM) (AST.NSimple $ highId) Nothing)
+    tfvec_range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit "-1") (AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerTM) (AST.NSimple highId) Nothing)
     tfvec_index_def = AST.SubtypeIn integerTM (Just tfvec_range)
 
 -- Create a use foo.bar.all statement. Takes a list of components in the used
@@ -112,40 +97,3 @@ createLibraryUnit bndr = do
   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)
--}