From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Mon, 6 Jul 2009 14:57:41 +0000 (+0200)
Subject: Caching converted tfp integers to speedup translation
X-Git-Url: https://git.stderr.nl/gitweb?p=matthijs%2Fmaster-project%2Fc%CE%BBash.git;a=commitdiff_plain;h=65d99830e416463d66f97581ece93da49f746778

Caching converted tfp integers to speedup translation
---

diff --git a/Adders.hs b/Adders.hs
index 67d7d95..94184b0 100644
--- a/Adders.hs
+++ b/Adders.hs
@@ -176,8 +176,8 @@ highordtest = \x ->
 
 xand a b = hwand a b
 
-functiontest :: TFVec D4 Bit -> TFVec D8 Bit
-functiontest = \v -> let r = v ++ $(vectorTH ([High,Low,High,Low] :: [Bit])) in r
+functiontest :: TFVec D4 (TFVec D3 Bit) -> (TFVec D12 Bit, TFVec D3 Bit)
+functiontest = \v -> let r = (concat v, head v) in r
 
 xhwnot x = hwnot x
 
diff --git a/CoreTools.hs b/CoreTools.hs
index 0297f90..3569d53 100644
--- a/CoreTools.hs
+++ b/CoreTools.hs
@@ -93,12 +93,14 @@ ranged_word_bound ty =
 
 -- | Get the length of a FSVec type
 tfvec_len :: Type.Type -> Int
-tfvec_len ty =
-  eval_tfp_int len
+tfvec_len ty = eval_tfp_int (tfvec_len_ty ty)
+
+tfvec_len_ty :: Type.Type -> Type.Type
+tfvec_len_ty ty = len
   where  
     args = case Type.splitTyConApp_maybe ty of
       Just (tycon, args) -> args
-      Nothing -> error $ "\nCoreTools.tfvec_len: Not a vector type: " ++ (pprString ty)
+      Nothing -> error $ "\nCoreTools.tfvec_len_ty: Not a vector type: " ++ (pprString ty)
     [len, el_ty] = args
     
 -- | Get the element type of a TFVec type
diff --git a/VHDLTools.hs b/VHDLTools.hs
index 8bc45f7..e4aad6f 100644
--- a/VHDLTools.hs
+++ b/VHDLTools.hs
@@ -447,8 +447,9 @@ 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 <- vec_len 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"
@@ -487,3 +488,15 @@ isReprType ty = do
   return $ case ty_either of
     Left _ -> False
     Right _ -> True
+
+vec_len :: Type.Type -> TypeSession Int
+vec_len ty = do
+  veclens <- getA vsTfpInts
+  let len_ty = tfvec_len_ty ty
+  let existing_len = Map.lookup (OrdType len_ty) veclens
+  case existing_len of
+    Just len -> return len
+    Nothing -> do
+      let new_len = tfvec_len ty
+      modA vsTfpInts (Map.insert (OrdType len_ty) (new_len))
+      return new_len
\ No newline at end of file
diff --git a/VHDLTypes.hs b/VHDLTypes.hs
index ff159fa..0bc1a5e 100644
--- a/VHDLTypes.hs
+++ b/VHDLTypes.hs
@@ -54,18 +54,21 @@ type TypeFunMap = Map.Map (OrdType, String) (AST.VHDLId, AST.SubProgBody)
 -- A map of a Haskell function to a hardware signature
 type SignatureMap = Map.Map CoreSyn.CoreBndr Entity
 
+type TfpIntMap = Map.Map OrdType Int
+
 data TypeState = TypeState {
   -- | A map of Core type -> VHDL Type
   vsTypes_      :: TypeMap,
   -- | A list of type declarations
   vsTypeDecls_  :: [AST.PackageDecItem],
   -- | A map of vector Core type -> VHDL type function
-  vsTypeFuns_   :: TypeFunMap
+  vsTypeFuns_   :: TypeFunMap,
+  vsTfpInts_    :: TfpIntMap
 }
 -- Derive accessors
 $( Data.Accessor.Template.deriveAccessors ''TypeState )
 -- Define an empty TypeState
-emptyTypeState = TypeState Map.empty [] Map.empty
+emptyTypeState = TypeState Map.empty [] Map.empty Map.empty
 -- Define a session
 type TypeSession = State.State TypeState