map (Arrow.second $ AST.DesignFile full_context) units
where
- init_session = VHDLState Map.empty Map.empty Map.empty Map.empty
+ init_session = VHDLState Map.empty [] Map.empty Map.empty
(units, final_session) =
State.runState (createLibraryUnits binds) init_session
tyfun_decls = map snd $ Map.elems (final_session ^.vsTypeFuns)
- ty_decls = map mktydecl $ Map.elems (final_session ^. vsTypes)
- vec_decls = map (\(v_id, v_def) -> AST.PDITD $ AST.TypeDec v_id v_def) (Map.elems (final_session ^. vsElemTypes))
+ ty_decls = final_session ^.vsTypeDecls
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) highId Nothing)
tfvec_index_def = AST.SubtypeIn integerTM (Just tfvec_range)
mkUseAll ["work", "types"]
: (mkUseAll ["work"]
: ieee_context)
- type_package_dec = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") ([tfvec_index_decl] ++ vec_decls ++ ty_decls ++ subProgSpecs)
+ type_package_dec = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") ([tfvec_index_decl] ++ ty_decls ++ subProgSpecs)
type_package_body = AST.LUPackageBody $ AST.PackageBody typesId tyfun_decls
subProgSpecs = map subProgSpec tyfun_decls
subProgSpec = \(AST.SubProgBody spec _ _) -> AST.PDISS spec
- mktydecl :: (AST.VHDLId, Either AST.TypeDef AST.SubtypeIn) -> AST.PackageDecItem
- mktydecl (ty_id, Left ty_def) = AST.PDITD $ AST.TypeDec ty_id ty_def
- mktydecl (ty_id, Right ty_def) = AST.PDISD $ AST.SubtypeDec ty_id ty_def
-- Create a use foo.bar.all statement. Takes a list of components in the used
-- name. Must contain at least two components
-- Assume the bndr has a valid VHDL id already
id = varToVHDLId bndr
ty = Var.varType bndr
+ 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 ty
+ type_mark <- vhdl_ty error_msg ty
return (id, type_mark)
)
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
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
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
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
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