X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=clash%2FCLasH%2FUtils%2FCore%2FCoreTools.hs;h=7d5423ccc16b39ccf2c96e8cd2ee8e4fc0eab242;hb=82a01c9291c350ee8aeae80d62d6a45f7fb50940;hp=a88bf47a8c2bbb926cfd69923a8c2b49d9d23795;hpb=ad03cc5631a7fe45b1ada4fb0ad2849558f4574e;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/clash/CLasH/Utils/Core/CoreTools.hs b/clash/CLasH/Utils/Core/CoreTools.hs
index a88bf47..7d5423c 100644
--- a/clash/CLasH/Utils/Core/CoreTools.hs
+++ b/clash/CLasH/Utils/Core/CoreTools.hs
@@ -152,16 +152,23 @@ tfvec_elem ty = el_ty
 -- | Gets the index of the given datacon in the given typed thing.
 -- Errors out if it does not occur or if the type is not an ADT.
 datacon_index :: TypedThing t => t -> DataCon.DataCon -> Int
-datacon_index tt dc =
+datacon_index tt dc = case List.elemIndex dc dcs of
+    Nothing -> error $ "Datacon " ++ pprString dc ++ " does not occur in typed thing: " ++ pprString tt
+    Just i -> i
+  where
+    dcs = datacons_for tt
+
+-- | Gets all datacons for the given typed thing. Errors out if the
+-- typed thing is not ADT typed.
+datacons_for :: TypedThing t => t -> [DataCon.DataCon]
+datacons_for tt =
   case getType tt of
     Nothing -> error $ "Getting datacon index of untyped thing? " ++ pprString tt
     Just ty -> case Type.splitTyConApp_maybe ty of
       Nothing -> error $ "Trying to find datacon in a type without a tycon?" ++ pprString ty
       Just (tycon, _) -> case TyCon.tyConDataCons_maybe tycon of
         Nothing -> error $ "Trying to find datacon in a type without datacons?" ++ pprString ty
-        Just dcs -> case List.elemIndex dc dcs of
-          Nothing -> error $ "Datacon " ++ pprString dc ++ " does not occur in type: " ++ pprString ty
-          Just i -> i
+        Just dcs -> dcs
 
 -- Is the given core expression a lambda abstraction?
 is_lam :: CoreSyn.CoreExpr -> Bool
@@ -464,7 +471,7 @@ mkSelCase scrut dc_i i = do
     Just (tycon, tyargs) -> case TyCon.tyConDataCons_maybe tycon of
       -- The scrutinee type should have a single dataconstructor,
       -- otherwise we can't construct a valid selector case.
-      Just dcs | i < 0 || i >= length dcs -> error $ "\nCoreTools.mkSelCase: Creating extractor case, but datacon index is invalid." ++ error_msg
+      Just dcs | dc_i < 0 || dc_i >= length dcs -> error $ "\nCoreTools.mkSelCase: Creating extractor case, but datacon index is invalid." ++ error_msg
                | otherwise -> do
         let datacon = (dcs!!dc_i)
         let field_tys = DataCon.dataConInstOrigArgTys datacon  tyargs