/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import init.meta.tactic init.function

namespace tactic
meta structure pattern :=
/- Term to match. -/
(target : expr)
/- Set of universes that is instantiated for each successful match. -/
(uoutput : list level)
/- Set of terms that is instantiated for each successful match. -/
(moutput : list expr)
/- Number of (temporary) universe meta-variables in this pattern. -/
(nuvars : nat)
/- Number of (temporary) meta-variables in this pattern. -/
(nmvars : nat)

/- (mk_pattern ls es t u o) creates a new pattern with (length ls) universe meta-variables and (length es) meta-variables.
   In the produced pattern p, we have that
   - (pattern.target p) is the term t where the universes ls and expressions es have been replaced with temporary meta-variables.
   - (pattern.uoutput p) is the list u where the universes ls have been replaced with temporary meta-variables.
   - (pattern.moutput p) is the list o where the universes ls and expressions es have been replaced with temporary meta-variables.
   - (pattern.nuvars p) = length ls
   - (pattern.nmvars p) = length es

   The tactic fails if o and the types of es do not contain all universes ls and expressions es. -/
meta constant mk_pattern : list level → list expr → expr → list level → list expr → tactic pattern
/- (mk_pattern_core m p e) matches (pattern.target p) and e using transparency m.
   If the matching is successful, then return the instantiation of (pattern.output p).
   The tactic fails if not all (temporary) meta-variables are assigned. -/
meta constant match_pattern_core : transparency → pattern → expr → tactic (list level × list expr)

meta def match_pattern (p : pattern) (e : expr) : tactic (list expr) :=
fmap prod.snd (match_pattern_core semireducible p e)

open expr

/- Helper function for converting a term (λ x_1 ... x_n, t) into a pattern
   where x_1 ... x_n are metavariables -/
private meta def to_pattern_core : expr → tactic (expr × list expr)
| (lam n bi d b) := do
   id         ← mk_fresh_name,
   let x     := local_const id n bi d,
   let new_b := instantiate_var b x,
   (p, xs) ← to_pattern_core new_b,
   return (p, x::xs)
| e              := return (e, [])

/- Given a pre-term of the form (λ x_1 ... x_n, t[x_1, ..., x_n]), converts it
   into the pattern t[?x_1, ..., ?x_n] -/
meta def pexpr_to_pattern (p : pexpr) : tactic pattern :=
do e ← to_expr p,
   (new_p, xs) ← to_pattern_core e,
   mk_pattern [] xs new_p [] xs

/- Convert pre-term into a pattern and try to match e.
   Given p of the form (λ x_1 ... x_n, t[x_1, ..., x_n]), a successful
   match will produce a list of length n. -/
meta def match_expr (p : pexpr) (e : expr) : tactic (list expr) :=
do new_p ← pexpr_to_pattern p,
   match_pattern new_p e

private meta def match_subexpr_core : pattern → list expr → tactic (list expr)
| p []      := failed
| p (e::es) :=
  match_pattern p e
  <|>
  match_subexpr_core p es
  <|>
  if is_app e then match_subexpr_core p (get_app_args e)
  else failed

/- Similar to match_expr, but it tries to match a subexpression of e.
   Remark: the procedure does not go inside binders. -/
meta def match_subexpr (p : pexpr) (e : expr) : tactic (list expr) :=
do new_p ← pexpr_to_pattern p,
   match_subexpr_core new_p [e]

/- Match the main goal target. -/
meta def match_target (p : pexpr) : tactic (list expr) :=
target >>= match_expr p

/- Match a subterm in the main goal target. -/
meta def match_target_subexpr (p : pexpr) : tactic (list expr) :=
target >>= match_subexpr p

private meta def match_hypothesis_core : pattern → list expr → tactic (expr × list expr)
| p []      := failed
| p (h::hs) := do
  h_type ← infer_type h,
  (do r ← match_pattern p h_type, return (h, r))
  <|>
  match_hypothesis_core p hs

/- Match hypothesis in the main goal target.
   The result is pair (hypothesis, substitution). -/
meta def match_hypothesis (p : pexpr) : tactic (expr × list expr) :=
do ctx ← local_context,
   new_p ← pexpr_to_pattern p,
   match_hypothesis_core new_p ctx

meta instance : has_to_tactic_format pattern :=
⟨λp, do
  t ← pp p^.target,
  mo ← pp p^.moutput,
  uo ← pp p^.uoutput,
  u ← pp p^.nuvars,
  m ← pp p^.nmvars,
  return $ to_fmt "pattern.mk (" ++ t ++ ") " ++ uo ++ " " ++ mo ++ " " ++ u ++ " " ++ m ++ "" ⟩

end tactic