X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=VHDLTools.hs;h=cf91cc7270fb45a9e844b437c254c770d22175ab;hb=78b45072fc36c7311bee97f2d9195bbc33b994cf;hp=8bc45f79a43490cb3f45c6e0ac3389d58337e085;hpb=35d10dbd4dcd24f3bd8a46e3a359d6f16dccfd32;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/VHDLTools.hs b/VHDLTools.hs
index 8bc45f7..cf91cc7 100644
--- a/VHDLTools.hs
+++ b/VHDLTools.hs
@@ -20,6 +20,7 @@ import qualified Name
 import qualified OccName
 import qualified Var
 import qualified Id
+import qualified IdInfo
 import qualified TyCon
 import qualified Type
 import qualified DataCon
@@ -143,6 +144,7 @@ varToVHDLExpr var =
         in
           res
 
+
 -- Turn a VHDLName into an AST expression
 vhdlNameToVHDLExpr = AST.PrimName
 
@@ -314,9 +316,8 @@ construct_vhdl_ty ty = do
       let name = Name.getOccString (TyCon.tyConName tycon)
       case name of
         "TFVec" -> mk_vector_ty ty
-        -- "SizedWord" -> do
-        --   res <- mk_vector_ty (sized_word_len ty) ty
-        --   return $ Just $ (Arrow.second Left) res
+        "SizedWord" -> mk_unsigned_ty ty
+        "SizedInt"  -> mk_signed_ty ty
         "RangedWord" -> mk_natural_ty 0 (ranged_word_bound ty)
         -- Create a custom type from this tycon
         otherwise -> mk_tycon_ty tycon args
@@ -408,6 +409,26 @@ mk_natural_ty min_bound max_bound = do
   let ty_def = AST.SubtypeIn naturalTM (Just range)
   return (Right (ty_id, Right ty_def))
 
+mk_unsigned_ty ::
+  Type.Type -- ^ Haskell type of the unsigned integer
+  -> TypeSession (Either String (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn))
+mk_unsigned_ty ty = do
+  let size  = sized_word_len ty
+  let ty_id = mkVHDLExtId $ "unsigned_" ++ show (size - 1)
+  let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (size - 1))]
+  let ty_def = AST.SubtypeIn unsignedTM (Just range)
+  return (Right (ty_id, Right ty_def))
+  
+mk_signed_ty ::
+  Type.Type -- ^ Haskell type of the signed integer
+  -> TypeSession (Either String (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn))
+mk_signed_ty ty = do
+  let size  = sized_word_len ty
+  let ty_id = mkVHDLExtId $ "signed_" ++ show (size - 1)
+  let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (size - 1))]
+  let ty_def = AST.SubtypeIn signedTM (Just range)
+  return (Right (ty_id, Right ty_def))
+
 -- Finds the field labels for VHDL type generated for the given Core type,
 -- which must result in a record type.
 getFieldLabels :: Type.Type -> TypeSession [AST.VHDLId]
@@ -447,12 +468,22 @@ mkHType ty = do
               elem_htype_either <- mkHType el_ty
               case elem_htype_either of
                 -- Could create element type
-                Right elem_htype ->
-                  return $ Right $ VecType (tfvec_len ty) elem_htype
+                Right elem_htype -> do
+                  len <- tfp_to_int (tfvec_len_ty ty)
+                  return $ Right $ VecType len elem_htype
                 -- Could not create element type
                 Left err -> return $ Left $ 
                   "VHDLTools.mkHType: Can not construct vectortype for elementtype: " ++ pprString el_ty  ++ "\n"
                   ++ err
+            "SizedWord" -> do
+              len <- tfp_to_int (sized_word_len_ty ty)
+              return $ Right $ SizedWType len
+            "SizedInt" -> do
+              len <- tfp_to_int (sized_word_len_ty ty)
+              return $ Right $ SizedIType len
+            "RangedWord" -> do
+              bound <- tfp_to_int (ranged_word_bound_ty ty)
+              return $ Right $ RangedWType bound
             otherwise -> do
               mkTyConHType tycon args
         Nothing -> return $ Right $ StdType $ OrdType ty
@@ -487,3 +518,14 @@ isReprType ty = do
   return $ case ty_either of
     Left _ -> False
     Right _ -> True
+
+tfp_to_int :: Type.Type -> TypeSession Int
+tfp_to_int ty = do
+  lens <- getA vsTfpInts
+  let existing_len = Map.lookup (OrdType ty) lens
+  case existing_len of
+    Just len -> return len
+    Nothing -> do
+      let new_len = eval_tfp_int ty
+      modA vsTfpInts (Map.insert (OrdType ty) (new_len))
+      return new_len
\ No newline at end of file