X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=VHDL.hs;h=289ecf50f413af09258160065b6e2c3682a46c60;hb=ce7380ad772e2a81c0329c6ee495e18fa0a62280;hp=c646f8b52858f210ea7b69fd816c082c8a03c9a4;hpb=969b7ddd86b69d2fc61b101961affcca0364749c;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/VHDL.hs b/VHDL.hs index c646f8b..289ecf5 100644 --- a/VHDL.hs +++ b/VHDL.hs @@ -119,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 @@ -129,45 +129,36 @@ 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 - ) + error_msg = "\nVHDL.createEntity.mkMap: Can not create entity: " ++ pprString fname ++ "\nbecause no type can be created for port: " ++ pprString bndr + in do + type_mark <- vhdl_ty error_msg 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 @@ -186,7 +177,7 @@ createArchitecture :: createArchitecture (fname, expr) = do signaturemap <- getA vsSignatures let signature = Maybe.fromMaybe - (error $ "Generating architecture for function " ++ (pprString fname) ++ "without signature? This should not happen!") + (error $ "\nVHDL.createArchitecture: Generating architecture for function \n" ++ (pprString fname) ++ "\nwithout signature? This should not happen!") (Map.lookup fname signaturemap) let entity_id = ent_id signature -- Strip off lambda's, these will be arguments @@ -249,7 +240,8 @@ getSignalId info = mkSigDec :: CoreSyn.CoreBndr -> VHDLSession (Maybe AST.SigDec) mkSigDec bndr = if True then do --isInternalSigUse use || isStateSigUse use then do - type_mark <- vhdl_ty $ Var.varType bndr + let error_msg = "\nVHDL.mkSigDec: Can not make signal declaration for type: \n" ++ pprString bndr + type_mark <- (vhdl_ty error_msg) $ Var.varType bndr return $ Just (AST.SigDec (varToVHDLId bndr) type_mark Nothing) else return Nothing @@ -272,8 +264,7 @@ mkConcSm (bndr, Var v) = return $ [mkUncondAssign (Left bndr) (varToVHDLExpr v)] 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' + let valargs = get_val_args (Var.varType f) args genApplication (Left bndr) f (map Left valargs) -- A single alt case must be a selector. This means thee scrutinee is a simple @@ -289,9 +280,9 @@ mkConcSm (bndr, expr@(Case (Var scrut) b ty [alt])) = 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) + Nothing -> error $ "\nVHDL.mkConcSM: Not in normal form: Not a selector case:\n" ++ (pprString expr) - _ -> error $ "VHDL.mkConcSM Not in normal form: Not a selector case:\n" ++ (pprString expr) + _ -> error $ "\nVHDL.mkConcSM: Not in normal form: Not a selector case:\n" ++ (pprString expr) -- Multiple case alt are be conditional assignments and have only wild -- binders in the alts and only variables in the case values and a variable @@ -304,6 +295,6 @@ mkConcSm (bndr, (Case (Var scrut) b ty [(_, _, Var false), (con, _, Var true)])) false_expr = (varToVHDLExpr false) in return [mkCondAssign (Left bndr) cond_expr true_expr false_expr] -mkConcSm (_, (Case (Var _) _ _ alts)) = error "VHDL.mkConcSm Not in normal form: Case statement with more than two alternatives" -mkConcSm (_, Case _ _ _ _) = error "VHDL.mkConcSm Not in normal form: Case statement has does not have a simple variable as scrutinee" -mkConcSm (bndr, expr) = error $ "VHDL.mkConcSM Unsupported binding in let expression: " ++ pprString bndr ++ " = " ++ pprString expr +mkConcSm (_, (Case (Var _) _ _ alts)) = error "\nVHDL.mkConcSm: Not in normal form: Case statement with more than two alternatives" +mkConcSm (_, Case _ _ _ _) = error "\nVHDL.mkConcSm: Not in normal form: Case statement has does not have a simple variable as scrutinee" +mkConcSm (bndr, expr) = error $ "\nVHDL.mkConcSM: Unsupported binding in let expression: " ++ pprString bndr ++ " = " ++ pprString expr