Move tfp_to_int from VHDLTools to CoreTools.

diff --git a/cλash/CLasH/Utils/Core/CoreTools.hs b/cλash/CLasH/Utils/Core/CoreTools.hs
index 9b276d659eabac9731b8f1fcb6c6205c00ebb1cc..9ac0fdf5f17d79691b47bc294fce72d5ce83789c 100644 (file)
--- a/cλash/CLasH/Utils/Core/CoreTools.hs
+++ b/cλash/CLasH/Utils/Core/CoreTools.hs
@@ -8,6 +8,7 @@ module CLasH.Utils.Core.CoreTools where
 --Standard modules
 import qualified Maybe
 import qualified System.IO.Unsafe
+import qualified Data.Map as Map
 
 -- GHC API
 import qualified GHC
@@ -46,7 +47,40 @@ import qualified CLasH.Utils.Core.BinderTools as BinderTools
 type Binding = (CoreSyn.CoreBndr, CoreSyn.CoreExpr)
 
 -- | Evaluate a core Type representing type level int from the tfp
--- library to a real int.
+-- library to a real int. Checks if the type really is a Dec type and
+-- caches the results.
+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" ->
+          tfp_to_int' ty
+        otherwise -> do
+          return $ error ("Callin tfp_to_int on non-dec:" ++ (show ty))
+    Nothing -> return $ error ("Callin tfp_to_int on non-dec:" ++ (show ty))
+
+-- | Evaluate a core Type representing type level int from the tfp
+-- library to a real int. Caches the results. Do not use directly, use
+-- tfp_to_int instead.
+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
+      
+-- | Evaluate a core Type representing type level int from the tfp
+-- library to a real int. Do not use directly, use tfp_to_int instead.
 eval_tfp_int :: HscTypes.HscEnv -> Type.Type -> Int
 eval_tfp_int env ty =
   unsafeRunGhc libdir $ do

diff --git a/cλash/CLasH/VHDL/VHDLTools.hs b/cλash/CLasH/VHDL/VHDLTools.hs
index 2dd0a48edcd397f8cfcc9e2f37adfe1f7f26dcdd..27517cdad2815e941a7771bdf68cd285f95d1da1 100644 (file)
--- a/cλash/CLasH/VHDL/VHDLTools.hs
+++ b/cλash/CLasH/VHDL/VHDLTools.hs
@@ -546,34 +546,6 @@ 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" ->
-          tfp_to_int' ty
-        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