X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=VHDL.hs;h=b6264dcf603266807297718c8e318a8e47dee878;hb=30414e977c5c4ba3c16441a281601c7c68f0fb6e;hp=920b83ed6be5de1f96c84f7d7fdf26ac8feeec20;hpb=0c113a538aa9a891935665481782bdce8350e345;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/VHDL.hs b/VHDL.hs index 920b83e..b6264dc 100644 --- a/VHDL.hs +++ b/VHDL.hs @@ -37,7 +37,6 @@ import Pretty import CoreTools import Constants import Generate -import GlobalNameTable createDesignFiles :: [(CoreSyn.CoreBndr, CoreSyn.CoreExpr)] @@ -120,7 +119,7 @@ createEntity (fname, expr) = do mkMap :: --[(SignalId, SignalInfo)] CoreSyn.CoreBndr - -> VHDLSession VHDLSignalMapElement + -> VHDLSession Port -- We only need the vsTypes element from the state mkMap = (\bndr -> let @@ -130,45 +129,35 @@ createEntity (fname, expr) = do -- Assume the bndr has a valid VHDL id already id = varToVHDLId bndr ty = Var.varType bndr - in - if True -- isPortSigUse $ sigUse info - then do - type_mark <- vhdl_ty ty - return $ Just (id, type_mark) - else - return $ Nothing - ) + in do + type_mark <- vhdl_ty ty + return (id, type_mark) + ) -- | Create the VHDL AST for an entity createEntityAST :: AST.VHDLId -- | The name of the function - -> [VHDLSignalMapElement] -- | The entity's arguments - -> VHDLSignalMapElement -- | The entity's result + -> [Port] -- | The entity's arguments + -> Port -- | The entity's result -> AST.EntityDec -- | The entity with the ent_decl filled in as well createEntityAST vhdl_id args res = AST.EntityDec vhdl_id ports where -- Create a basic Id, since VHDL doesn't grok filenames with extended Ids. - ports = Maybe.catMaybes $ - map (mkIfaceSigDec AST.In) args + ports = map (mkIfaceSigDec AST.In) args ++ [mkIfaceSigDec AST.Out res] ++ [clk_port] -- Add a clk port if we have state - clk_port = if True -- hasState hsfunc - then - Just $ AST.IfaceSigDec (mkVHDLExtId "clk") AST.In std_logicTM - else - Nothing + clk_port = AST.IfaceSigDec (mkVHDLExtId "clk") AST.In std_logicTM -- | Create a port declaration mkIfaceSigDec :: AST.Mode -- | The mode for the port (In / Out) - -> Maybe (AST.VHDLId, AST.TypeMark) -- | The id and type for the port - -> Maybe AST.IfaceSigDec -- | The resulting port declaration + -> (AST.VHDLId, AST.TypeMark) -- | The id and type for the port + -> AST.IfaceSigDec -- | The resulting port declaration -mkIfaceSigDec mode (Just (id, ty)) = Just $ AST.IfaceSigDec id mode ty -mkIfaceSigDec _ Nothing = Nothing +mkIfaceSigDec mode (id, ty) = AST.IfaceSigDec id mode ty {- -- | Generate a VHDL entity name for the given hsfunc @@ -275,52 +264,7 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do let (CoreSyn.Var f, args) = CoreSyn.collectArgs app let valargs' = filter isValArg args let valargs = filter (\(CoreSyn.Var bndr) -> not (Id.isDictId bndr)) valargs' - case Var.globalIdVarDetails f of - IdInfo.DataConWorkId dc -> - -- It's a datacon. Create a record from its arguments. - -- First, filter out type args. TODO: Is this the best way to do this? - -- The types should already have been taken into acocunt when creating - -- the signal, so this should probably work... - --let valargs = filter isValArg args in - if all is_var valargs then do - labels <- getFieldLabels (CoreUtils.exprType app) - return $ zipWith mkassign labels valargs - else - error $ "VHDL.mkConcSm Not in normal form: One ore more complex arguments: " ++ pprString args - where - mkassign :: AST.VHDLId -> CoreExpr -> AST.ConcSm - mkassign label (Var arg) = - let sel_name = mkSelectedName bndr label in - mkUncondAssign (Right sel_name) (varToVHDLExpr arg) - IdInfo.VanillaGlobal -> do - -- It's a global value imported from elsewhere. These can be builtin - -- functions. - signatures <- getA vsSignatures - case (Map.lookup (varToString f) globalNameTable) of - Just (arg_count, builder) -> - if length valargs == arg_count then - builder bndr f valargs - else - error $ "VHDL.mkConcSm Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ pprString valargs - Nothing -> error $ "Using function from another module that is not a known builtin: " ++ pprString f - IdInfo.NotGlobalId -> 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. - let - signature = Maybe.fromMaybe - (error $ "Using function '" ++ (varToString f) ++ "' without signature? This should not happen!") - (Map.lookup f signatures) - entity_id = ent_id signature - label = "comp_ins_" ++ varToString bndr - -- Add a clk port if we have state - --clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk" - clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk" - --portmaps = mkAssocElems sigs args res signature ++ (if hasState hsfunc then [clk_port] else []) - portmaps = clk_port : mkAssocElems args bndr signature - in - return [mkComponentInst label entity_id portmaps] - details -> error $ "Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details + genApplication (Left bndr) f (map Left valargs) -- A single alt case must be a selector. This means thee scrutinee is a simple -- variable, the alternative is a dataalt with a single non-wild binder that @@ -332,7 +276,7 @@ mkConcSm (bndr, expr@(Case (Var scrut) b ty [alt])) = Just i -> do labels <- getFieldLabels (Id.idType scrut) let label = labels!!i - let sel_name = mkSelectedName scrut label + let sel_name = mkSelectedName (varToVHDLName scrut) label let sel_expr = AST.PrimName sel_name return [mkUncondAssign (Left bndr) sel_expr] Nothing -> error $ "VHDL.mkConcSM Not in normal form: Not a selector case:\n" ++ (pprString expr)