---
--- ASSUMPTION (A):
--- A1. No top-level variable is bound in the target
--- A2. No template variable is bound in the target
--- A3. No lambda bound template variable is free in any subexpression of the target
---
--- To see why A1 is necessary, consider matching
--- \x->f against \f->f
--- When we meet the lambdas we substitute [f/x] in the template (a no-op),
--- and then erroneously succeed in matching f against f.
---
--- To see why A2 is needed consider matching
--- forall a. \b->b against \a->3
--- When we meet the lambdas we substitute [a/b] in the template, and then
--- erroneously succeed in matching what looks like the template variable 'a' against 3.
---
--- A3 is needed to validate the rule that says
--- (\x->E) matches F
--- if
--- (\x->E) matches (\x->F x)
-
-
-matchRule in_scope rule@(BuiltinRule match_fn) args = match_fn args
-
-matchRule in_scope rule@(Rule rn tpl_vars tpl_args rhs) args
- = go tpl_args args emptySubst
- -- We used to use the in_scope set, but I don't think that's necessary
- -- After all, the result is going to be simplified again with that in_scope set
- where
- tpl_var_set = mkVarSet tpl_vars
-
- -----------------------
- -- Do the business
- go (tpl_arg:tpl_args) (arg:args) subst = match tpl_arg arg tpl_var_set (go tpl_args args) subst
-
- -- Two easy ways to terminate
- go [] [] subst = Just (rn, app_match subst (mkLams tpl_vars rhs) tpl_vars)
- go [] args subst = Just (rn, app_match subst (mkLams tpl_vars rhs) tpl_vars `mkApps` args)
-
- -- One tiresome way to terminate: check for excess unmatched
- -- template arguments
- go tpl_args [] subst = Nothing -- Failure
-
-
- -----------------------
- app_match subst fn vs = foldl go fn vs
- where
- senv = substEnv subst
- go fn v = case lookupSubstEnv senv v of
- Just (DoneEx ex) -> fn `App` ex
- Just (DoneTy ty) -> fn `App` Type ty
- -- Substitution should bind them all!
-
-
- -----------------------
-{- The code below tries to match even if there are more
- template args than real args.
-
- I now think this is probably a bad idea.
- Should the template (map f xs) match (map g)? I think not.
- For a start, in general eta expansion wastes work.
- SLPJ July 99
-
- = case eta_complete tpl_args (mkVarSet leftovers) of
- Just leftovers' -> Just (rn, mkLams done (mkLams leftovers' rhs),
- mk_result_args subst done)
- Nothing -> Nothing -- Failure
- where
- (done, leftovers) = partition (\v -> maybeToBool (lookupSubstEnv subst_env v))
- (map zapOccInfo tpl_vars)
- -- Zap the occ info
- subst_env = substEnv subst
-
- -----------------------
- eta_complete [] vars = ASSERT( isEmptyVarSet vars )
- Just []
- eta_complete (Type ty:tpl_args) vars
- = case getTyVar_maybe ty of
- Just tv | tv `elemVarSet` vars
- -> case eta_complete tpl_args (vars `delVarSet` tv) of
- Just vars' -> Just (tv:vars')
- Nothing -> Nothing
- other -> Nothing
-
- eta_complete (Var v:tpl_args) vars
- | v `elemVarSet` vars
- = case eta_complete tpl_args (vars `delVarSet` v) of
- Just vars' -> Just (v:vars')
- Nothing -> Nothing
-
- eta_complete other vars = Nothing
-
-
-zapOccInfo bndr | isTyVar bndr = bndr
- | otherwise = zapLamIdInfo bndr
--}