Midstream check-in on

   (i) Replaced a lot of clunky and fragile EvVar handling code with
       a more uniform ``flavor transformer'' API in the canonicalizer
       and the interaction solver. Now EvVars are just fields inside
       the CtFlavors.
   (ii) Significantly simplified our caching story
This patch does not validate yet and more refactoring is on the way.

1 files changed, 39 insertions, 1 deletions

diff --git a/compiler/coreSyn/TrieMap.lhs b/compiler/coreSyn/TrieMap.lhs
index d8a134ed87..fefea6dfdb 100644
--- a/compiler/coreSyn/TrieMap.lhs
+++ b/compiler/coreSyn/TrieMap.lhs
@@ -14,7 +14,7 @@
 {-# LANGUAGE TypeFamilies #-}
 module TrieMap(
    CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap,
-   TypeMap, foldTypeMap, 
+   TypeMap, foldTypeMap, lookupTypeMap_mod,
    CoercionMap, 
    MaybeMap, 
    ListMap,
@@ -521,6 +521,44 @@ lkT env ty m
     go (TyConApp tc tys) = tm_tc_app >.> lkNamed tc >=> lkList (lkT env) tys
     go (ForAllTy tv ty)  = tm_forall >.> lkT (extendCME env tv) ty >=> lkBndr env tv
 
+
+lkT_mod :: CmEnv  
+        -> TyVarEnv a   -- A substitution 
+        -> (a -> Type)
+        -> Type
+        -> TypeMap b -> Maybe b 
+lkT_mod env s f ty m
+  | EmptyTM <- m = Nothing
+  | Just ty' <- coreView ty
+  = lkT_mod env s f ty' m
+  | isEmptyVarEnv candidates 
+  = go env s ty m
+  | otherwise
+  = Just $ head (varEnvElts candidates) -- Yikes!
+  where  
+    candidates = filterVarEnv_Directly find_matching (vm_fvar $ tm_var m)
+    find_matching tv _b = case lookupVarEnv_Directly s tv of
+      Nothing -> False
+      Just a -> f a `eqType` ty            
+    go env _s (TyVarTy v)      = tm_var    >.> lkVar env v
+    go env s (AppTy t1 t2)     = tm_app    >.> lkT_mod env s f t1 >=> lkT_mod env s f t2
+    go env s (FunTy t1 t2)     = tm_fun    >.> lkT_mod env s f t1 >=> lkT_mod env s f t2
+    go env s (TyConApp tc tys) = tm_tc_app >.> lkNamed tc >=> lkList (lkT_mod env s f) tys
+    go _env _s (ForAllTy _tv _ty)  = const Nothing
+    {- TODO: bleah the following is wrong! 
+      = let (s',inscope') = substTyVarBndr tv (s,inscope)
+        in 
+      let s' = delVarEnv s tv  -- I think it's enough to just restrict substution
+                                 -- without renaming anything
+        in tm_forall >.> lkT_mod (extendCME env tv) s' f ty >=> lkBndr env tv
+     -}
+
+lookupTypeMap_mod :: TyVarEnv a -- A substitution to be applied to the /keys/ of type map 
+                  -> (a -> Type)
+                  -> Type 
+                  -> TypeMap b -> Maybe b
+lookupTypeMap_mod = lkT_mod emptyCME
+
 -----------------
 xtT :: CmEnv -> Type -> XT a -> TypeMap a -> TypeMap a
 xtT env ty f m