projects
/
matthijs
/
master-project
/
cλash.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Remove compatability aliases for the old sessions.
[matthijs/master-project/cλash.git]
/
cλash
/
CLasH
/
VHDL
/
VHDLTools.hs
diff --git
a/cλash/CLasH/VHDL/VHDLTools.hs
b/cλash/CLasH/VHDL/VHDLTools.hs
index 412e0c4a2dfa26193b33777f19282b169c3be8c0..fbe33a7e3ebe56814e4c00a7b187843f8953f593 100644
(file)
--- a/
cλash/CLasH/VHDL/VHDLTools.hs
+++ b/
cλash/CLasH/VHDL/VHDLTools.hs
@@
-30,6
+30,7
@@
import qualified CoreSubst
-- Local imports
import CLasH.VHDL.VHDLTypes
-- Local imports
import CLasH.VHDL.VHDLTypes
+import CLasH.Translator.TranslatorTypes
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
@@
-108,6
+109,10
@@
mkAssocElemIndexed :: AST.VHDLId -> AST.VHDLId -> AST.VHDLId -> AST.AssocElem
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])))
+-- | Create an aggregate signal
+mkAggregateSignal :: [AST.Expr] -> AST.Expr
+mkAggregateSignal x = AST.Aggregate (map (\z -> AST.ElemAssoc Nothing z) x)
+
mkComponentInst ::
String -- ^ The portmap label
-> AST.VHDLId -- ^ The entity name
mkComponentInst ::
String -- ^ The portmap label
-> AST.VHDLId -- ^ The entity name
@@
-277,7
+282,7
@@
vhdl_ty msg 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
-- Returns either an error message or the resulting type.
vhdl_ty_either :: Type.Type -> TypeSession (Either String AST.TypeMark)
vhdl_ty_either ty = do
- typemap <- getA
v
sTypes
+ typemap <- getA
t
sTypes
htype_either <- mkHType ty
case htype_either of
-- No errors
htype_either <- mkHType ty
case htype_either of
-- No errors
@@
-297,8
+302,8
@@
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
v
sTypes (Map.insert htype (ty_id, ty_def))
- modA
v
sTypeDecls (\typedefs -> typedefs ++ [mktydecl (ty_id, ty_def)])
+ modA
t
sTypes (Map.insert htype (ty_id, ty_def))
+ modA
t
sTypeDecls (\typedefs -> typedefs ++ [mktydecl (ty_id, ty_def)])
return (Right ty_id)
Left err -> return $ Left $
"VHDLTools.vhdl_ty: Unsupported Haskell type: " ++ pprString ty ++ "\n"
return (Right ty_id)
Left err -> return $ Left $
"VHDLTools.vhdl_ty: Unsupported Haskell type: " ++ pprString ty ++ "\n"
@@
-349,7
+354,7
@@
mk_tycon_ty ty tycon args =
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
- modA
v
sTypeFuns $ Map.insert (OrdType ty, showIdString) (showId, tupshow)
+ modA
t
sTypeFuns $ Map.insert (OrdType ty, showIdString) (showId, tupshow)
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 $
@@
-372,8
+377,8
@@
mk_vector_ty ::
-- ^ An error message or The typemark created.
mk_vector_ty ty = do
-- ^ An error message or The typemark created.
mk_vector_ty ty = do
- types_map <- getA
v
sTypes
- env <- getA
v
sHscEnv
+ types_map <- getA
t
sTypes
+ env <- getA
t
sHscEnv
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
@@
-393,10
+398,10
@@
mk_vector_ty ty = do
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
v
sTypes (Map.insert (StdType $ OrdType vec_ty) (vec_id, (Left vec_def)))
- modA
v
sTypeDecls (\typedefs -> typedefs ++ [mktydecl (vec_id, (Left vec_def))])
+ modA
t
sTypes (Map.insert (StdType $ OrdType vec_ty) (vec_id, (Left vec_def)))
+ modA
t
sTypeDecls (\typedefs -> typedefs ++ [mktydecl (vec_id, (Left vec_def))])
let vecShowFuns = mkVectorShow el_ty_tm vec_id
let vecShowFuns = mkVectorShow el_ty_tm vec_id
- mapM_ (\(id, subprog) -> modA
v
sTypeFuns $ Map.insert (OrdType vec_ty, id) ((mkVHDLExtId id), subprog)) vecShowFuns
+ mapM_ (\(id, subprog) -> modA
t
sTypeFuns $ 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
@@
-424,7
+429,7
@@
mk_unsigned_ty ty = do
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
- modA
v
sTypeFuns $ Map.insert (OrdType ty, showIdString) (showId, unsignedshow)
+ modA
t
sTypeFuns $ Map.insert (OrdType ty, showIdString) (showId, unsignedshow)
return (Right (ty_id, Right ty_def))
mk_signed_ty ::
return (Right (ty_id, Right ty_def))
mk_signed_ty ::
@@
-436,7
+441,7
@@
mk_signed_ty ty = do
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
- modA
v
sTypeFuns $ Map.insert (OrdType ty, showIdString) (showId, signedshow)
+ modA
t
sTypeFuns $ Map.insert (OrdType ty, showIdString) (showId, signedshow)
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,
@@
-447,7
+452,7
@@
getFieldLabels ty = do
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
- types <- getA
v
sTypes
+ types <- getA
t
sTypes
-- 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
@@
-532,7
+537,7
@@
isReprType ty = do
tfp_to_int :: Type.Type -> TypeSession Int
tfp_to_int ty = do
tfp_to_int :: Type.Type -> TypeSession Int
tfp_to_int ty = do
- hscenv <- getA
v
sHscEnv
+ hscenv <- getA
t
sHscEnv
let norm_ty = normalise_tfp_int hscenv ty
case Type.splitTyConApp_maybe norm_ty of
Just (tycon, args) -> do
let norm_ty = normalise_tfp_int hscenv ty
case Type.splitTyConApp_maybe norm_ty of
Just (tycon, args) -> do
@@
-542,21
+547,21
@@
tfp_to_int ty = do
len <- tfp_to_int' ty
return len
otherwise -> do
len <- tfp_to_int' ty
return len
otherwise -> do
- modA
v
sTfpInts (Map.insert (OrdType norm_ty) (-1))
+ modA
t
sTfpInts (Map.insert (OrdType norm_ty) (-1))
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
- lens <- getA
v
sTfpInts
- hscenv <- getA
v
sHscEnv
+ lens <- getA
t
sTfpInts
+ hscenv <- getA
t
sHscEnv
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
- modA
v
sTfpInts (Map.insert (OrdType norm_ty) (new_len))
+ modA
t
sTfpInts (Map.insert (OrdType norm_ty) (new_len))
return new_len
mkTupleShow ::
return new_len
mkTupleShow ::
@@
-693,11
+698,11
@@
genExprPCall2 entid arg1 arg2 =
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 :: CoreSyn.CoreBndr ->
VHDL
Session (Maybe AST.SigDec)
+mkSigDec :: CoreSyn.CoreBndr ->
Translator
Session (Maybe AST.SigDec)
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
- type_mark <- MonadState.lift
v
sType $ vhdl_ty error_msg (Var.varType bndr)
+ type_mark <- MonadState.lift
t
sType $ vhdl_ty error_msg (Var.varType bndr)
return $ Just (AST.SigDec (varToVHDLId bndr) type_mark Nothing)
else
return Nothing
return $ Just (AST.SigDec (varToVHDLId bndr) type_mark Nothing)
else
return Nothing