X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FUtils%2FCore%2FCoreTools.hs;h=2bb688bb7f0c023a1d9b7986a97eb581f22b808c;hb=6b25abd35ae3cfe2fe42b9d0446d35d0dd118f98;hp=09595702570cfe8745e49ec8190c4afd6d3fe44b;hpb=8663a3e3f2776039a31528c3087ef5725d401932;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git "a/c\316\273ash/CLasH/Utils/Core/CoreTools.hs" "b/c\316\273ash/CLasH/Utils/Core/CoreTools.hs"
index 0959570..2bb688b 100644
--- "a/c\316\273ash/CLasH/Utils/Core/CoreTools.hs"
+++ "b/c\316\273ash/CLasH/Utils/Core/CoreTools.hs"
@@ -53,7 +53,7 @@ type Binding = (CoreSyn.CoreBndr, CoreSyn.CoreExpr)
 tfp_to_int :: Type.Type -> TypeSession Int
 tfp_to_int ty = do
   hscenv <- MonadState.get tsHscEnv
-  let norm_ty = normalise_tfp_int hscenv ty
+  let norm_ty = normalize_tfp_int hscenv ty
   case Type.splitTyConApp_maybe norm_ty of
     Just (tycon, args) -> do
       let name = Name.getOccString (TyCon.tyConName tycon)
@@ -71,7 +71,7 @@ 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 norm_ty = normalize_tfp_int hscenv ty
   let existing_len = Map.lookup (OrdType norm_ty) lens
   case existing_len of
     Just len -> return len
@@ -101,15 +101,11 @@ eval_tfp_int env ty =
     libdir = DynFlags.topDir dynflags
     dynflags = HscTypes.hsc_dflags env
 
-normalise_tfp_int :: HscTypes.HscEnv -> Type.Type -> Type.Type
-normalise_tfp_int env ty =
+normalize_tfp_int :: HscTypes.HscEnv -> Type.Type -> Type.Type
+normalize_tfp_int env ty =
    System.IO.Unsafe.unsafePerformIO $
-     normaliseType env ty
+     normalizeType env ty
 
--- | Get the width of a SizedWord type
--- sized_word_len :: HscTypes.HscEnv -> Type.Type -> Int
--- sized_word_len env ty = eval_tfp_int env (sized_word_len_ty ty)
-    
 sized_word_len_ty :: Type.Type -> Type.Type
 sized_word_len_ty ty = len
   where
@@ -118,10 +114,6 @@ sized_word_len_ty ty = len
       Nothing -> error $ "\nCoreTools.sized_word_len_ty: Not a sized word type: " ++ (pprString ty)
     [len]         = args
 
--- | Get the width of a SizedInt type
--- sized_int_len :: HscTypes.HscEnv -> Type.Type -> Int
--- sized_int_len env ty = eval_tfp_int env (sized_int_len_ty ty)
-
 sized_int_len_ty :: Type.Type -> Type.Type
 sized_int_len_ty ty = len
   where
@@ -130,10 +122,6 @@ sized_int_len_ty ty = len
       Nothing -> error $ "\nCoreTools.sized_int_len_ty: Not a sized int type: " ++ (pprString ty)
     [len]         = args
     
--- | Get the upperbound of a RangedWord type
--- ranged_word_bound :: HscTypes.HscEnv -> Type.Type -> Int
--- ranged_word_bound env ty = eval_tfp_int env (ranged_word_bound_ty ty)
-    
 ranged_word_bound_ty :: Type.Type -> Type.Type
 ranged_word_bound_ty ty = len
   where
@@ -142,26 +130,6 @@ ranged_word_bound_ty ty = len
       Nothing -> error $ "\nCoreTools.ranged_word_bound_ty: Not a sized word type: " ++ (pprString ty)
     [len]         = args
 
--- | Evaluate a core Type representing type level int from the TypeLevel
--- library to a real int.
--- eval_type_level_int :: Type.Type -> Int
--- eval_type_level_int ty =
---   unsafeRunGhc $ do
---     -- Automatically import modules for any fully qualified identifiers
---     setDynFlag DynFlags.Opt_ImplicitImportQualified
--- 
---     let to_int_name = mkRdrName "Data.TypeLevel.Num.Sets" "toInt"
---     let to_int = SrcLoc.noLoc $ HsExpr.HsVar to_int_name
---     let undef = hsTypedUndef $ coreToHsType ty
---     let app = HsExpr.HsApp (to_int) (undef)
--- 
---     core <- toCore [] app
---     execCore core 
-
--- | Get the length of a FSVec type
--- tfvec_len :: HscTypes.HscEnv -> Type.Type -> Int
--- tfvec_len env ty = eval_tfp_int env (tfvec_len_ty ty)
-
 tfvec_len_ty :: Type.Type -> Type.Type
 tfvec_len_ty ty = len
   where  
@@ -492,4 +460,4 @@ mkSelCase scrut i = do
         let binders = take i wildbndrs ++ [sel_bndr] ++ drop (i+1) wildbndrs
         return $ CoreSyn.Case scrut scrut_bndr scrut_ty [(CoreSyn.DataAlt datacon, binders, CoreSyn.Var sel_bndr)]
       dcs -> error $ "CoreTools.mkSelCase: Scrutinee type must have exactly one datacon. Extracting element " ++ (show i) ++ " from '" ++ pprString scrut ++ "' Datacons: " ++ (show dcs) ++ " Type: " ++ (pprString scrut_ty)
-    Nothing -> error $ "CoreTools.mkSelCase: Creating extractor case, but scrutinee has no tycon? Extracting element " ++ (show i) ++ " from '" ++ pprString scrut ++ "'"
+    Nothing -> error $ "CoreTools.mkSelCase: Creating extractor case, but scrutinee has no tycon? Extracting element " ++ (show i) ++ " from '" ++ pprString scrut ++ "'" ++ " Type: " ++ (pprString scrut_ty)