Move tfp_to_int from VHDLTools to CoreTools.

[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 263d364d021b5b3dbe4ff086c60523c2694cc74d..27517cdad2815e941a7771bdf68cd285f95d1da1 100644 (file)
--- a/cλash/CLasH/VHDL/VHDLTools.hs
+++ b/cλash/CLasH/VHDL/VHDLTools.hs
@@ -304,6 +304,8 @@ isReprType ty = do
     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
@@ -312,6 +314,8 @@ mkHType msg ty = do
     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 tything =
@@ -486,6 +490,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))
+    -- 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
 
@@ -531,43 +536,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
-    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
-    _ -> error $ "\nVHDLTools.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
 
-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