-nullSpecEnv :: SpecEnv
-nullSpecEnv = SpecEnv nullMEnv
-
-isNullSpecEnv :: SpecEnv -> Bool
-isNullSpecEnv (SpecEnv env) = null (mEnvToList env)
-
-addOneToSpecEnv :: SpecEnv -> [Type] -> CoreExpr -> MaybeErr SpecEnv ([Type], SimplifiableCoreExpr)
-addOneToSpecEnv (SpecEnv env) tys rhs
- = --pprTrace "addOneToSpecEnv" (($$) (ppr PprDebug tys) (ppr PprDebug rhs)) $
- case (insertMEnv matchTys env tys (occurAnalyseGlobalExpr rhs)) of
- Succeeded menv -> Succeeded (SpecEnv menv)
- Failed err -> Failed err
-
-lookupSpecEnv :: SpecEnv -> [Type] -> Maybe (SimplifiableCoreExpr, ([(TyVar,Type)], [Type]))
-lookupSpecEnv (SpecEnv env) tys
- | all isTyVarTy tys = Nothing -- Short cut: no specialisation for simple tyvars
- | otherwise = --pprTrace "lookupSpecEnv" (ppr PprDebug tys) $
- lookupMEnv matchTys env tys
+data SpecEnvResult val
+ = Match Subst val -- Match, instantiating only
+ -- type variables in the template
+
+ | CouldMatch -- A match could happen if the
+ -- some of the type variables in the key
+ -- were further instantiated.
+
+ | NoMatch -- No match possible, regardless of how
+ -- the key is further instantiated
+
+-- If the key *unifies* with one of the templates, then the
+-- result is Match or CouldMatch, depending on whether any of the
+-- type variables in the key had to be instantiated
+
+unifySpecEnv :: SpecEnv value -- The envt
+ -> [Type] -- Key
+ -> SpecEnvResult value
+
+
+unifySpecEnv EmptySE key = NoMatch
+unifySpecEnv (SpecEnv alist) key
+ = find alist
+ where
+ find [] = NoMatch
+ find ((tpl, val) : rest)
+ = case unifyTyListsX tpl key of
+ Nothing -> find rest
+ Just subst | all uninstantiated (tyVarSetToList (tyVarsOfTypes key))
+ -> Match subst val
+ | otherwise
+ -> CouldMatch
+ where
+ uninstantiated tv = case lookupTyVarEnv subst tv of
+ Just xx -> False
+ Nothing -> True
+
+-- matchSpecEnv does a one-way match only, but in return
+-- it is more polymorphic than unifySpecEnv
+
+matchSpecEnv :: SpecEnv value -- The envt
+ -> [GenType flexi] -- Key
+ -> Maybe (TyVarEnv (GenType flexi), value)
+
+matchSpecEnv EmptySE key = Nothing
+matchSpecEnv (SpecEnv alist) key
+ = find alist
+ where
+ find [] = Nothing
+ find ((tpl, val) : rest)
+ = case matchTys tpl key of
+ Nothing -> find rest
+ Just (subst, leftovers) -> ASSERT( null leftovers )
+ Just (subst, val)