From: Christiaan Baaij 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?a=commitdiff_plain;h=65d99830e416463d66f97581ece93da49f746778;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git 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