import CLasH.Utils.Core.CoreTools
import CLasH.Utils.Pretty
import CLasH.VHDL.Constants
import CLasH.Utils.Core.CoreTools
import CLasH.Utils.Pretty
import CLasH.VHDL.Constants
- Either CoreBndr AST.VHDLName -> -- ^ The signal to assign to
- Maybe (AST.Expr , AST.Expr) -> -- ^ Optionally, the condition to test for
+ Either CoreBndr AST.VHDLName -- ^ The signal to assign to
+ -> Maybe (AST.Expr , AST.Expr) -- ^ Optionally, the condition to test for
- AST.Expr -> -- ^ The value to assign when false or no condition
- AST.ConcSm -- ^ The resulting concurrent statement
+ -> AST.Expr -- ^ The value to assign when false or no condition
+ -> AST.ConcSm -- ^ The resulting concurrent statement
mkAssign dst cond false_expr =
let
-- I'm not 100% how this assignment AST works, but this gets us what we
mkAssign dst cond false_expr =
let
-- I'm not 100% how this assignment AST works, but this gets us what we
- [AST.Expr] -- | The argument that are applied to function
- -> AST.VHDLName -- | The binder in which to store the result
- -> Entity -- | The entity to map against.
- -> [AST.AssocElem] -- | The resulting port maps
+ [AST.Expr] -- ^ The argument that are applied to function
+ -> AST.VHDLName -- ^ The binder in which to store the result
+ -> Entity -- ^ The entity to map against.
+ -> [AST.AssocElem] -- ^ The resulting port maps
mkAssocElems args res entity =
-- Create the actual AssocElems
zipWith mkAssocElem ports sigs
mkAssocElems args res entity =
-- Create the actual AssocElems
zipWith mkAssocElem ports sigs
mkAssocElemIndexed port signal index = Just port AST.:=>: (AST.ADName (AST.NIndexed (AST.IndexedName
(AST.NSimple signal) [AST.PrimName $ AST.NSimple index])))
mkAssocElemIndexed port signal index = Just port AST.:=>: (AST.ADName (AST.NIndexed (AST.IndexedName
(AST.NSimple signal) [AST.PrimName $ AST.NSimple index])))
-- Returns either an error message or the resulting type.
vhdl_ty_either :: Type.Type -> TypeSession (Either String AST.TypeMark)
vhdl_ty_either ty = do
-- Returns either an error message or the resulting type.
vhdl_ty_either :: Type.Type -> TypeSession (Either String AST.TypeMark)
vhdl_ty_either ty = do
case newty_maybe of
Right (ty_id, ty_def) -> do
-- TODO: Check name uniqueness
case newty_maybe of
Right (ty_id, ty_def) -> do
-- TODO: Check name uniqueness
- modA vsTypes (Map.insert htype (ty_id, ty_def))
- modA vsTypeDecls (\typedefs -> typedefs ++ [mktydecl (ty_id, ty_def)])
+ modA tsTypes (Map.insert htype (ty_id, ty_def))
+ modA tsTypeDecls (\typedefs -> typedefs ++ [mktydecl (ty_id, ty_def)])
let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon) ++ elem_names
let ty_def = AST.TDR $ AST.RecordTypeDef elems
let tupshow = mkTupleShow elem_tys ty_id
let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon) ++ elem_names
let ty_def = AST.TDR $ AST.RecordTypeDef elems
let tupshow = mkTupleShow elem_tys ty_id
return $ Right (ty_id, Left ty_def)
-- There were errors in element types
(errors, _) -> return $ Left $
return $ Right (ty_id, Left ty_def)
-- There were errors in element types
(errors, _) -> return $ Left $
let (nvec_l, nvec_el) = Type.splitAppTy ty
let (nvec, leng) = Type.splitAppTy nvec_l
let vec_ty = Type.mkAppTy nvec nvec_el
let (nvec_l, nvec_el) = Type.splitAppTy ty
let (nvec, leng) = Type.splitAppTy nvec_l
let vec_ty = Type.mkAppTy nvec nvec_el
Nothing -> do
let vec_id = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId el_ty_tm)
let vec_def = AST.TDA $ AST.UnconsArrayDef [tfvec_indexTM] el_ty_tm
Nothing -> do
let vec_id = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId el_ty_tm)
let vec_def = AST.TDA $ AST.UnconsArrayDef [tfvec_indexTM] el_ty_tm
- modA vsTypes (Map.insert (StdType $ OrdType vec_ty) (vec_id, (Left vec_def)))
- modA vsTypeDecls (\typedefs -> typedefs ++ [mktydecl (vec_id, (Left vec_def))])
+ modA tsTypes (Map.insert (StdType $ OrdType vec_ty) (vec_id, (Left vec_def)))
+ modA tsTypeDecls (\typedefs -> typedefs ++ [mktydecl (vec_id, (Left vec_def))])
- mapM_ (\(id, subprog) -> modA vsTypeFuns $ Map.insert (OrdType vec_ty, id) ((mkVHDLExtId id), subprog)) vecShowFuns
+ mapM_ (\(id, subprog) -> modA tsTypeFuns $ Map.insert (OrdType vec_ty, id) ((mkVHDLExtId id), subprog)) vecShowFuns
let ty_def = AST.SubtypeIn vec_id (Just range)
return (Right (ty_id, Right ty_def))
-- Could not create element type
let ty_def = AST.SubtypeIn vec_id (Just range)
return (Right (ty_id, Right ty_def))
-- Could not create element type
let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (size - 1))]
let ty_def = AST.SubtypeIn unsignedTM (Just range)
let unsignedshow = mkIntegerShow ty_id
let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (size - 1))]
let ty_def = AST.SubtypeIn unsignedTM (Just range)
let unsignedshow = mkIntegerShow ty_id
let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (size - 1))]
let ty_def = AST.SubtypeIn signedTM (Just range)
let signedshow = mkIntegerShow ty_id
let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (size - 1))]
let ty_def = AST.SubtypeIn signedTM (Just range)
let signedshow = mkIntegerShow ty_id
return (Right (ty_id, Right ty_def))
-- Finds the field labels for VHDL type generated for the given Core type,
return (Right (ty_id, Right ty_def))
-- Finds the field labels for VHDL type generated for the given Core type,
let error_msg = "\nVHDLTools.getFieldLabels: Can not get field labels, because: " ++ pprString ty ++ "can not be generated."
vhdl_ty error_msg ty
-- Get the types map, lookup and unpack the VHDL TypeDef
let error_msg = "\nVHDLTools.getFieldLabels: Can not get field labels, because: " ++ pprString ty ++ "can not be generated."
vhdl_ty error_msg ty
-- Get the types map, lookup and unpack the VHDL TypeDef
-- Assume the type for which we want labels is really translatable
Right htype <- mkHType ty
case Map.lookup htype types of
-- Assume the type for which we want labels is really translatable
Right htype <- mkHType ty
case Map.lookup htype types of
return $ error ("Callin tfp_to_int on non-dec:" ++ (show ty))
Nothing -> return $ error ("Callin tfp_to_int on non-dec:" ++ (show ty))
tfp_to_int' :: Type.Type -> TypeSession Int
tfp_to_int' ty = do
return $ error ("Callin tfp_to_int on non-dec:" ++ (show ty))
Nothing -> return $ error ("Callin tfp_to_int on non-dec:" ++ (show ty))
tfp_to_int' :: Type.Type -> TypeSession Int
tfp_to_int' ty = do
let norm_ty = normalise_tfp_int hscenv ty
let existing_len = Map.lookup (OrdType norm_ty) lens
case existing_len of
Just len -> return len
Nothing -> do
let new_len = eval_tfp_int hscenv ty
let norm_ty = normalise_tfp_int hscenv ty
let existing_len = Map.lookup (OrdType norm_ty) lens
case existing_len of
Just len -> return len
Nothing -> do
let new_len = eval_tfp_int hscenv ty
AST.ProcCall (AST.NSimple entid) $
map (\exp -> Nothing AST.:=>: AST.ADExpr exp) [arg1,arg2]
AST.ProcCall (AST.NSimple entid) $
map (\exp -> Nothing AST.:=>: AST.ADExpr exp) [arg1,arg2]
mkSigDec bndr =
if True then do --isInternalSigUse use || isStateSigUse use then do
let error_msg = "\nVHDL.mkSigDec: Can not make signal declaration for type: \n" ++ pprString bndr
mkSigDec bndr =
if True then do --isInternalSigUse use || isStateSigUse use then do
let error_msg = "\nVHDL.mkSigDec: Can not make signal declaration for type: \n" ++ pprString bndr