No longer treat tfp ints as builtin types.

[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 db3e13acdf200bd199d2f9d49b617722baf3f18d..716663025e9698753f3a3ce55be5c366f74fba7d 100644 (file)
--- a/cλash/CLasH/VHDL/VHDLTools.hs
+++ b/cλash/CLasH/VHDL/VHDLTools.hs
@@ -8,22 +8,17 @@ import qualified Data.List as List
 import qualified Data.Char as Char
 import qualified Data.Map as Map
 import qualified Control.Monad as Monad
 import qualified Data.Char as Char
 import qualified Data.Map as Map
 import qualified Control.Monad as Monad

-import qualified Control.Arrow as Arrow
-import qualified Control.Monad.Trans.State as State
-import qualified Data.Monoid as Monoid
-import Data.Accessor.Monad.Trans.State as MonadState
-import Debug.Trace
+import qualified Data.Accessor.Monad.Trans.State as MonadState

 
 

--- ForSyDe
+-- VHDL Imports

 import qualified Language.VHDL.AST as AST
 
 -- GHC API
 import qualified Language.VHDL.AST as AST
 
 -- GHC API

-import CoreSyn
+import qualified CoreSyn

 import qualified Name
 import qualified OccName
 import qualified Var
 import qualified Id
 import qualified Name
 import qualified OccName
 import qualified Var
 import qualified Id

-import qualified IdInfo

 import qualified TyCon
 import qualified Type
 import qualified DataCon
 import qualified TyCon
 import qualified Type
 import qualified DataCon


@@ -44,14 +39,14 @@ import CLasH.VHDL.Constants
 
 -- Create an unconditional assignment statement
 mkUncondAssign ::
 
 -- Create an unconditional assignment statement
 mkUncondAssign ::

-  Either CoreBndr AST.VHDLName -- ^ The signal to assign to
+  Either CoreSyn.CoreBndr AST.VHDLName -- ^ The signal to assign to

   -> AST.Expr -- ^ The expression to assign
   -> AST.ConcSm -- ^ The resulting concurrent statement
 mkUncondAssign dst expr = mkAssign dst Nothing expr
 
 -- Create a conditional assignment statement
 mkCondAssign ::
   -> AST.Expr -- ^ The expression to assign
   -> AST.ConcSm -- ^ The resulting concurrent statement
 mkUncondAssign dst expr = mkAssign dst Nothing expr
 
 -- Create a conditional assignment statement
 mkCondAssign ::

-  Either CoreBndr AST.VHDLName -- ^ The signal to assign to
+  Either CoreSyn.CoreBndr AST.VHDLName -- ^ The signal to assign to

   -> AST.Expr -- ^ The condition
   -> AST.Expr -- ^ The value when true
   -> AST.Expr -- ^ The value when false
   -> AST.Expr -- ^ The condition
   -> AST.Expr -- ^ The value when true
   -> AST.Expr -- ^ The value when false


@@ -60,7 +55,7 @@ mkCondAssign dst cond true false = mkAssign dst (Just (cond, true)) false
 
 -- Create a conditional or unconditional assignment statement
 mkAssign ::
 
 -- Create a conditional or unconditional assignment statement
 mkAssign ::

-  Either CoreBndr AST.VHDLName -- ^ The signal to assign to
+  Either CoreSyn.CoreBndr AST.VHDLName -- ^ The signal to assign to

   -> Maybe (AST.Expr , AST.Expr) -- ^ Optionally, the condition to test for
                                  -- and the value to assign when true.
   -> AST.Expr -- ^ The value to assign when false or no condition
   -> Maybe (AST.Expr , AST.Expr) -- ^ Optionally, the condition to test for
                                  -- and the value to assign when true.
   -> AST.Expr -- ^ The value to assign when false or no condition


@@ -85,12 +80,12 @@ mkAssign dst cond false_expr =
     AST.CSSASm assign
 
 mkAltsAssign ::
     AST.CSSASm assign
 
 mkAltsAssign ::

-  Either CoreBndr AST.VHDLName            -- ^ The signal to assign to
+  Either CoreSyn.CoreBndr AST.VHDLName            -- ^ The signal to assign to

   -> [AST.Expr]       -- ^ The conditions
   -> [AST.Expr]       -- ^ The expressions
   -> AST.ConcSm   -- ^ The Alt assigns
 mkAltsAssign dst conds exprs
   -> [AST.Expr]       -- ^ The conditions
   -> [AST.Expr]       -- ^ The expressions
   -> AST.ConcSm   -- ^ The Alt assigns
 mkAltsAssign dst conds exprs

-        | (length conds) /= ((length exprs) - 1) = error $ "\nVHDLTools.mkAltsAssign: conditions expression mismatch"
+        | (length conds) /= ((length exprs) - 1) = error "\nVHDLTools.mkAltsAssign: conditions expression mismatch"

         | otherwise =
   let
     whenelses   = zipWith mkWhenElse conds exprs
         | otherwise =
   let
     whenelses   = zipWith mkWhenElse conds exprs


@@ -151,25 +146,12 @@ mkComponentInst label entity_id portassigns = AST.CSISm compins
 -----------------------------------------------------------------------------
 
 varToVHDLExpr :: Var.Var -> TypeSession AST.Expr
 -----------------------------------------------------------------------------
 
 varToVHDLExpr :: Var.Var -> TypeSession AST.Expr

-varToVHDLExpr var = do
+varToVHDLExpr var =

   case Id.isDataConWorkId_maybe var of
   case Id.isDataConWorkId_maybe var of

-    Just dc -> dataconToVHDLExpr dc

     -- This is a dataconstructor.
     -- This is a dataconstructor.

-    -- Not a datacon, just another signal. Perhaps we should check for
-    -- local/global here as well?
-    -- Sadly so.. tfp decimals are types, not data constructors, but instances
-    -- should still be translated to integer literals. It is probebly not the
-    -- best solution to translate them here.
-    -- FIXME: Find a better solution for translating instances of tfp integers
-    Nothing -> do
-        let ty  = Var.varType var
-        case Type.splitTyConApp_maybe ty of
-                Just (tycon, args) ->
-                  case Name.getOccString (TyCon.tyConName tycon) of
-                    "Dec" -> do
-                      len <- tfp_to_int ty
-                      return $ AST.PrimLit $ (show len)
-                    otherwise -> return $ AST.PrimName $ AST.NSimple $ varToVHDLId var
+    Just dc -> dataconToVHDLExpr dc
+    -- Not a datacon, just another signal.
+    Nothing -> return $ AST.PrimName $ AST.NSimple $ varToVHDLId var

 
 -- Turn a VHDLName into an AST expression
 vhdlNameToVHDLExpr = AST.PrimName
 
 -- Turn a VHDLName into an AST expression
 vhdlNameToVHDLExpr = AST.PrimName


@@ -184,10 +166,10 @@ exprToVHDLExpr core = varToVHDLExpr (exprToVar core)
 -- dataconstructors, this is only the constructor itself, not any arguments it
 -- has. Should not be called with a DEFAULT constructor.
 altconToVHDLExpr :: CoreSyn.AltCon -> TypeSession AST.Expr
 -- dataconstructors, this is only the constructor itself, not any arguments it
 -- has. Should not be called with a DEFAULT constructor.
 altconToVHDLExpr :: CoreSyn.AltCon -> TypeSession AST.Expr

-altconToVHDLExpr (DataAlt dc) = dataconToVHDLExpr dc
+altconToVHDLExpr (CoreSyn.DataAlt dc) = dataconToVHDLExpr dc

 
 

-altconToVHDLExpr (LitAlt _) = error "\nVHDL.conToVHDLExpr: Literals not support in case alternatives yet"
-altconToVHDLExpr DEFAULT = error "\nVHDL.conToVHDLExpr: DEFAULT alternative should not occur here!"
+altconToVHDLExpr (CoreSyn.LitAlt _) = error "\nVHDL.conToVHDLExpr: Literals not support in case alternatives yet"
+altconToVHDLExpr CoreSyn.DEFAULT = error "\nVHDL.conToVHDLExpr: DEFAULT alternative should not occur here!"

 
 -- Turn a datacon (without arguments!) into a VHDL expression.
 dataconToVHDLExpr :: DataCon.DataCon -> TypeSession AST.Expr
 
 -- Turn a datacon (without arguments!) into a VHDL expression.
 dataconToVHDLExpr :: DataCon.DataCon -> TypeSession AST.Expr


@@ -202,7 +184,7 @@ dataconToVHDLExpr dc = do
         (BuiltinType "Bit") -> return $ AST.PrimLit $ case Name.getOccString dcname of "High" -> "'1'"; "Low" -> "'0'"
         (BuiltinType "Bool") -> return $ AST.PrimLit $ case Name.getOccString dcname of "True" -> "true"; "False" -> "false"
         otherwise -> do
         (BuiltinType "Bit") -> return $ AST.PrimLit $ case Name.getOccString dcname of "High" -> "'1'"; "Low" -> "'0'"
         (BuiltinType "Bool") -> return $ AST.PrimLit $ case Name.getOccString dcname of "True" -> "true"; "False" -> "false"
         otherwise -> do

-          let existing_ty = (Monad.liftM $ fmap fst) $ Map.lookup htype typemap
+          let existing_ty = Monad.liftM (fmap fst) $ Map.lookup htype typemap

           case existing_ty of
             Just ty -> do
               let lit    = idToVHDLExpr $ mkVHDLExtId $ Name.getOccString dcname
           case existing_ty of
             Just ty -> do
               let lit    = idToVHDLExpr $ mkVHDLExtId $ Name.getOccString dcname


@@ -219,7 +201,7 @@ dataconToVHDLExpr dc = do
 varToVHDLId ::
   CoreSyn.CoreBndr
   -> AST.VHDLId
 varToVHDLId ::
   CoreSyn.CoreBndr
   -> AST.VHDLId

-varToVHDLId var = mkVHDLExtId $ (varToString var ++ varToStringUniq var ++ (show $ lowers $ varToStringUniq var))
+varToVHDLId var = mkVHDLExtId (varToString var ++ varToStringUniq var ++ show (lowers $ varToStringUniq var))

   where
     lowers :: String -> Int
     lowers xs = length [x | x <- xs, Char.isLower x]
   where
     lowers :: String -> Int
     lowers xs = length [x | x <- xs, Char.isLower x]


@@ -258,7 +240,7 @@ mkVHDLBasicId s =
     -- Strip leading numbers and underscores
     strip_leading = dropWhile (`elem` ['0'..'9'] ++ "_")
     -- Strip multiple adjacent underscores
     -- Strip leading numbers and underscores
     strip_leading = dropWhile (`elem` ['0'..'9'] ++ "_")
     -- Strip multiple adjacent underscores

-    strip_multiscore = concat . map (\cs -> 
+    strip_multiscore = concatMap (\cs -> 

         case cs of 
           ('_':_) -> "_"
           _ -> cs
         case cs of 
           ('_':_) -> "_"
           _ -> cs


@@ -297,8 +279,7 @@ builtin_types :: TypeMap
 builtin_types = 
   Map.fromList [
     (BuiltinType "Bit", Just (std_logicTM, Nothing)),
 builtin_types = 
   Map.fromList [
     (BuiltinType "Bit", Just (std_logicTM, Nothing)),

-    (BuiltinType "Bool", Just (booleanTM, Nothing)), -- TysWiredIn.boolTy
-    (BuiltinType "Dec", Just (integerTM, Nothing))
+    (BuiltinType "Bool", Just (booleanTM, Nothing)) -- TysWiredIn.boolTy

   ]
 
 -- Is the given type representable at runtime?
   ]
 
 -- Is the given type representable at runtime?


@@ -309,6 +290,8 @@ isReprType ty = do
     Left _ -> False
     Right _ -> True
 
     Left _ -> False
     Right _ -> True
 

+-- | Turn a Core type into a HType, returning an error using the given
+-- error string if the type was not representable.

 mkHType :: (TypedThing t, Outputable.Outputable t) => 
   String -> t -> TypeSession HType
 mkHType msg ty = do
 mkHType :: (TypedThing t, Outputable.Outputable t) => 
   String -> t -> TypeSession HType
 mkHType msg ty = do


@@ -317,9 +300,11 @@ mkHType msg ty = do
     Right htype -> return htype
     Left err -> error $ msg ++ err  
 
     Right htype -> return htype
     Left err -> error $ msg ++ err  
 

+-- | Turn a Core type into a HType. Returns either an error message if
+-- the type was not representable, or the HType generated.

 mkHTypeEither :: (TypedThing t, Outputable.Outputable t) => 
   t -> TypeSession (Either String HType)
 mkHTypeEither :: (TypedThing t, Outputable.Outputable t) => 
   t -> TypeSession (Either String HType)

-mkHTypeEither tything = do
+mkHTypeEither tything =

   case getType tything of
     Nothing -> return $ Left $ "\nVHDLTools.mkHTypeEither: Typed thing without a type: " ++ pprString tything
     Just ty -> mkHTypeEither' ty
   case getType tything of
     Nothing -> return $ Left $ "\nVHDLTools.mkHTypeEither: Typed thing without a type: " ++ pprString tything
     Just ty -> mkHTypeEither' ty


@@ -327,7 +312,7 @@ mkHTypeEither tything = do
 mkHTypeEither' :: Type.Type -> TypeSession (Either String HType)
 mkHTypeEither' ty | ty_has_free_tyvars ty = return $ Left $ "\nVHDLTools.mkHTypeEither': Cannot create type: type has free type variables: " ++ pprString ty
                   | isStateType ty = return $ Right StateType
 mkHTypeEither' :: Type.Type -> TypeSession (Either String HType)
 mkHTypeEither' ty | ty_has_free_tyvars ty = return $ Left $ "\nVHDLTools.mkHTypeEither': Cannot create type: type has free type variables: " ++ pprString ty
                   | isStateType ty = return $ Right StateType

-                  | otherwise = do
+                  | otherwise =

   case Type.splitTyConApp_maybe ty of
     Just (tycon, args) -> do
       typemap <- MonadState.get tsTypes
   case Type.splitTyConApp_maybe ty of
     Just (tycon, args) -> do
       typemap <- MonadState.get tsTypes


@@ -335,7 +320,7 @@ mkHTypeEither' ty | ty_has_free_tyvars ty = return $ Left $ "\nVHDLTools.mkHType
       let builtinTyMaybe = Map.lookup (BuiltinType name) typemap  
       case builtinTyMaybe of
         (Just x) -> return $ Right $ BuiltinType name
       let builtinTyMaybe = Map.lookup (BuiltinType name) typemap  
       case builtinTyMaybe of
         (Just x) -> return $ Right $ BuiltinType name

-        Nothing -> do
+        Nothing ->

           case name of
                 "TFVec" -> do
                   let el_ty = tfvec_elem ty
           case name of
                 "TFVec" -> do
                   let el_ty = tfvec_elem ty


@@ -357,7 +342,7 @@ mkHTypeEither' ty | ty_has_free_tyvars ty = return $ Left $ "\nVHDLTools.mkHType
                 "RangedWord" -> do
                   bound <- tfp_to_int (ranged_word_bound_ty ty)
                   return $ Right $ RangedWType bound
                 "RangedWord" -> do
                   bound <- tfp_to_int (ranged_word_bound_ty ty)
                   return $ Right $ RangedWType bound

-                otherwise -> do
+                otherwise ->

                   mkTyConHType tycon args
     Nothing -> return $ Left $ "\nVHDLTools.mkHTypeEither': Do not know what to do with type: " ++ pprString ty
 
                   mkTyConHType tycon args
     Nothing -> return $ Left $ "\nVHDLTools.mkHTypeEither': Do not know what to do with type: " ++ pprString ty
 


@@ -372,17 +357,17 @@ mkTyConHType tycon args =
       let real_arg_tys_nostate = filter (\x -> not (isStateType x)) real_arg_tys
       elem_htys_either <- mapM mkHTypeEither real_arg_tys_nostate
       case Either.partitionEithers elem_htys_either of
       let real_arg_tys_nostate = filter (\x -> not (isStateType x)) real_arg_tys
       elem_htys_either <- mapM mkHTypeEither real_arg_tys_nostate
       case Either.partitionEithers elem_htys_either of

-        ([], [elem_hty]) -> do
+        ([], [elem_hty]) ->

           return $ Right elem_hty
         -- No errors in element types
           return $ Right elem_hty
         -- No errors in element types

-        ([], elem_htys) -> do
+        ([], elem_htys) ->

           return $ Right $ AggrType (nameToString (TyCon.tyConName tycon)) elem_htys
         -- There were errors in element types
         (errors, _) -> return $ Left $
           "\nVHDLTools.mkTyConHType: Can not construct type for: " ++ pprString tycon ++ "\n because no type can be construced for some of the arguments.\n"
           ++ (concat errors)
     dcs -> do
           return $ Right $ AggrType (nameToString (TyCon.tyConName tycon)) elem_htys
         -- There were errors in element types
         (errors, _) -> return $ Left $
           "\nVHDLTools.mkTyConHType: Can not construct type for: " ++ pprString tycon ++ "\n because no type can be construced for some of the arguments.\n"
           ++ (concat errors)
     dcs -> do

-      let arg_tys = concat $ map DataCon.dataConRepArgTys dcs
+      let arg_tys = concatMap DataCon.dataConRepArgTys dcs

       let real_arg_tys = map (CoreSubst.substTy subst) arg_tys
       case real_arg_tys of
         [] ->
       let real_arg_tys = map (CoreSubst.substTy subst) arg_tys
       case real_arg_tys of
         [] ->


@@ -400,8 +385,7 @@ vhdlTy :: (TypedThing t, Outputable.Outputable t) =>
   String -> t -> TypeSession (Maybe AST.TypeMark)
 vhdlTy msg ty = do
   htype <- mkHType msg ty
   String -> t -> TypeSession (Maybe AST.TypeMark)
 vhdlTy msg ty = do
   htype <- mkHType msg ty

-  tm <- vhdlTyMaybe htype
-  return tm
+  vhdlTyMaybe htype

 
 vhdlTyMaybe :: HType -> TypeSession (Maybe AST.TypeMark)
 vhdlTyMaybe htype = do
 
 vhdlTyMaybe :: HType -> TypeSession (Maybe AST.TypeMark)
 vhdlTyMaybe htype = do


@@ -426,7 +410,7 @@ vhdlTyMaybe htype = do
 -- message or the resulting typemark and typedef.
 construct_vhdl_ty :: HType -> TypeSession TypeMapRec
 -- State types don't generate VHDL
 -- message or the resulting typemark and typedef.
 construct_vhdl_ty :: HType -> TypeSession TypeMapRec
 -- State types don't generate VHDL

-construct_vhdl_ty htype = do
+construct_vhdl_ty htype =

     case htype of
       StateType -> return  Nothing
       (SizedWType w) -> mkUnsignedTy w
     case htype of
       StateType -> return  Nothing
       (SizedWType w) -> mkUnsignedTy w


@@ -447,7 +431,7 @@ mkTyconTy htype =
           return Nothing
         elem_tys -> do
           let elems = zipWith AST.ElementDec recordlabels elem_tys  
           return Nothing
         elem_tys -> do
           let elems = zipWith AST.ElementDec recordlabels elem_tys  

-          let elem_names = concat $ map prettyShow elem_tys
+          let elem_names = concatMap prettyShow elem_tys

           let ty_id = mkVHDLExtId $ tycon ++ elem_names
           let ty_def = AST.TDR $ AST.RecordTypeDef elems
           let tupshow = mkTupleShow elem_tys ty_id
           let ty_id = mkVHDLExtId $ tycon ++ elem_names
           let ty_def = AST.TDR $ AST.RecordTypeDef elems
           let tupshow = mkTupleShow elem_tys ty_id


@@ -478,7 +462,7 @@ mkVectorTy (VecType len elHType) = do
     (Just elTyTm) -> do
       let ty_id = mkVHDLExtId $ "vector-"++ (AST.fromVHDLId elTyTm) ++ "-0_to_" ++ (show len)
       let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len - 1))]
     (Just elTyTm) -> do
       let ty_id = mkVHDLExtId $ "vector-"++ (AST.fromVHDLId elTyTm) ++ "-0_to_" ++ (show len)
       let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len - 1))]

-      let existing_uvec_ty = (fmap $ fmap fst) $ Map.lookup (UVecType elHType) typesMap
+      let existing_uvec_ty = fmap (fmap fst) $ Map.lookup (UVecType elHType) typesMap

       case existing_uvec_ty of
         Just (Just t) -> do
           let ty_def = AST.SubtypeIn t (Just range)
       case existing_uvec_ty of
         Just (Just t) -> do
           let ty_def = AST.SubtypeIn t (Just range)


@@ -492,6 +476,7 @@ mkVectorTy (VecType len elHType) = do
           mapM_ (\(id, subprog) -> MonadState.modify tsTypeFuns $ Map.insert (UVecType elHType, id) ((mkVHDLExtId id), subprog)) vecShowFuns
           let ty_def = AST.SubtypeIn vec_id (Just range)
           return (Just (ty_id, Just $ Right ty_def))
           mapM_ (\(id, subprog) -> MonadState.modify tsTypeFuns $ Map.insert (UVecType elHType, id) ((mkVHDLExtId id), subprog)) vecShowFuns
           let ty_def = AST.SubtypeIn vec_id (Just range)
           return (Just (ty_id, Just $ Right ty_def))

+    -- Vector of empty elements becomes empty itself.

     Nothing -> return Nothing
 mkVectorTy htype = error $ "\nVHDLTools.mkVectorTy: Called for HType that is not a VecType: " ++ show htype
 
     Nothing -> return Nothing
 mkVectorTy htype = error $ "\nVHDLTools.mkVectorTy: Called for HType that is not a VecType: " ++ show htype
 


@@ -537,44 +522,16 @@ getFieldLabels ty = do
   -- Assume the type for which we want labels is really translatable
   htype <- mkHType error_msg ty
   case Map.lookup htype types of
   -- Assume the type for which we want labels is really translatable
   htype <- mkHType error_msg ty
   case Map.lookup htype types of

-    Just (Just (_, Just (Left (AST.TDR (AST.RecordTypeDef elems))))) -> return $ map (\(AST.ElementDec id _) -> id) elems
+    Nothing -> error $ "\nVHDLTools.getFieldLabels: Type not found? This should not happen!\nLooking for type: " ++ (pprString ty) ++ "\nhtype: " ++ (show htype) 

     Just Nothing -> return [] -- The type is empty
     Just Nothing -> return [] -- The type is empty

-    _ -> error $ "\nVHDL.getFieldLabels: Type not found or not a record type? This should not happen! Type: " ++ (show htype)
+    Just (Just (_, Just (Left (AST.TDR (AST.RecordTypeDef elems))))) -> return $ map (\(AST.ElementDec id _) -> id) elems
+    Just (Just (_, Just vty)) -> error $ "\nVHDLTools.getFieldLabels: Type not a record type? This should not happen!\nLooking for type: " ++ pprString (ty) ++ "\nhtype: " ++ (show htype) ++ "\nFound type: " ++ (show vty)

     
 mktydecl :: (AST.VHDLId, Maybe (Either AST.TypeDef AST.SubtypeIn)) -> Maybe AST.PackageDecItem
 mytydecl (_, Nothing) = Nothing
 mktydecl (ty_id, Just (Left ty_def)) = Just $ AST.PDITD $ AST.TypeDec ty_id ty_def
 mktydecl (ty_id, Just (Right ty_def)) = Just $ AST.PDISD $ AST.SubtypeDec ty_id ty_def
 
     
 mktydecl :: (AST.VHDLId, Maybe (Either AST.TypeDef AST.SubtypeIn)) -> Maybe AST.PackageDecItem
 mytydecl (_, Nothing) = Nothing
 mktydecl (ty_id, Just (Left ty_def)) = Just $ AST.PDITD $ AST.TypeDec ty_id ty_def
 mktydecl (ty_id, Just (Right ty_def)) = Just $ AST.PDISD $ AST.SubtypeDec ty_id ty_def
 

-tfp_to_int :: Type.Type -> TypeSession Int
-tfp_to_int ty = do
-  hscenv <- MonadState.get tsHscEnv
-  let norm_ty = normalise_tfp_int hscenv ty
-  case Type.splitTyConApp_maybe norm_ty of
-    Just (tycon, args) -> do
-      let name = Name.getOccString (TyCon.tyConName tycon)
-      case name of
-        "Dec" -> do
-          len <- tfp_to_int' ty
-          return len
-        otherwise -> do
-          MonadState.modify tsTfpInts (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
-  lens <- MonadState.get tsTfpInts
-  hscenv <- MonadState.get tsHscEnv
-  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
-      MonadState.modify tsTfpInts (Map.insert (OrdType norm_ty) (new_len))
-      return new_len
-      

 mkTupleShow :: 
   [AST.TypeMark] -- ^ type of each tuple element
   -> AST.TypeMark -- ^ type of the tuple
 mkTupleShow :: 
   [AST.TypeMark] -- ^ type of each tuple element
   -> AST.TypeMark -- ^ type of the tuple


@@ -624,7 +581,7 @@ mkVectorShow elemTM vectorTM =
     resId   = AST.unsafeVHDLBasicId "res"
     headSpec = AST.Function (mkVHDLExtId headId) [AST.IfaceVarDec vecPar vectorTM] elemTM
     -- return vec(0);
     resId   = AST.unsafeVHDLBasicId "res"
     headSpec = AST.Function (mkVHDLExtId headId) [AST.IfaceVarDec vecPar vectorTM] elemTM
     -- return vec(0);

-    headExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName 
+    headExpr = AST.ReturnSm (Just (AST.PrimName $ AST.NIndexed (AST.IndexedName 

                     (AST.NSimple vecPar) [AST.PrimLit "0"])))
     vecSlice init last =  AST.PrimName (AST.NSlice 
                                       (AST.SliceName 
                     (AST.NSimple vecPar) [AST.PrimLit "0"])))
     vecSlice init last =  AST.PrimName (AST.NSlice 
                                       (AST.SliceName 


@@ -710,13 +667,13 @@ mkBuiltInShow = [ AST.SubProgBody showBitSpec [] [showBitExpr]
                         AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId) 
                         (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [signToInt]) Nothing )
                       where
                         AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId) 
                         (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [signToInt]) Nothing )
                       where

-                        signToInt = genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ signedPar)
+                        signToInt = genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple signedPar)

     showUnsignedSpec =  AST.Function showId [AST.IfaceVarDec unsignedPar unsignedTM] stringTM
     showUnsignedExpr =  AST.ReturnSm (Just $
                           AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId) 
                           (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [unsignToInt]) Nothing )
                         where
     showUnsignedSpec =  AST.Function showId [AST.IfaceVarDec unsignedPar unsignedTM] stringTM
     showUnsignedExpr =  AST.ReturnSm (Just $
                           AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId) 
                           (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [unsignToInt]) Nothing )
                         where

-                          unsignToInt = genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ unsignedPar)
+                          unsignToInt = genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple unsignedPar)

     -- showNaturalSpec = AST.Function showId [AST.IfaceVarDec naturalPar naturalTM] stringTM
     -- showNaturalExpr = AST.ReturnSm (Just $
     --                     AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId)
     -- showNaturalSpec = AST.Function showId [AST.IfaceVarDec naturalPar naturalTM] stringTM
     -- showNaturalExpr = AST.ReturnSm (Just $
     --                     AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId)