129 lines
4.3 KiB
Text
129 lines
4.3 KiB
Text
/-
|
||
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.meta.format init.function
|
||
|
||
structure param_info :=
|
||
(is_implicit : bool)
|
||
(is_inst_implicit : bool)
|
||
(is_prop : bool)
|
||
(has_fwd_deps : bool)
|
||
(back_deps : list nat) -- previous parameters it depends on
|
||
|
||
open format list decidable
|
||
|
||
private meta def ppfield {α : Type} [has_to_format α] (fname : string) (v : α) : format :=
|
||
group $ to_fmt fname ++ space ++ to_fmt ":=" ++ space ++ nest (length fname + 4) (to_fmt v)
|
||
|
||
private meta def concat_fields (f₁ f₂ : format) : format :=
|
||
if is_nil f₁ then f₂
|
||
else if is_nil f₂ then f₁
|
||
else f₁ ++ to_fmt "," ++ line ++ f₂
|
||
|
||
local infix `+++`:65 := concat_fields
|
||
|
||
meta def param_info.to_format : param_info → format
|
||
| (param_info.mk i ii p d ds) :=
|
||
group ∘ cbrace $
|
||
when i "implicit" +++
|
||
when ii "inst_implicit" +++
|
||
when p "prop" +++
|
||
when d "has_fwd_deps" +++
|
||
when (length ds > 0) (to_fmt "back_deps := " ++ to_fmt ds)
|
||
|
||
meta instance : has_to_format param_info :=
|
||
has_to_format.mk param_info.to_format
|
||
|
||
structure fun_info :=
|
||
(params : list param_info)
|
||
(result_deps : list nat) -- parameters the result type depends on
|
||
|
||
meta def fun_info_to_format : fun_info → format
|
||
| (fun_info.mk ps ds) :=
|
||
group ∘ dcbrace $
|
||
ppfield "params" ps +++
|
||
ppfield "result_deps" ds
|
||
|
||
meta instance : has_to_format fun_info :=
|
||
has_to_format.mk fun_info_to_format
|
||
|
||
/-
|
||
specialized is true if the result of fun_info has been specifialized
|
||
using this argument.
|
||
For example, consider the function
|
||
|
||
f : Pi (α : Type), α -> α
|
||
|
||
Now, suppse we request get_specialize fun_info for the application
|
||
|
||
f unit a
|
||
|
||
fun_info_manager returns two param_info objects:
|
||
1) specialized = true
|
||
2) is_subsingleton = true
|
||
|
||
Note that, in general, the second argument of f is not a subsingleton,
|
||
but it is in this particular case/specialization.
|
||
|
||
\remark This bit is only set if it is a dependent parameter.
|
||
|
||
Moreover, we only set is_specialized IF another parameter
|
||
becomes a subsingleton -/
|
||
structure subsingleton_info :=
|
||
(specialized : bool)
|
||
(is_subsingleton : bool)
|
||
|
||
meta def subsingleton_info_to_format : subsingleton_info → format
|
||
| (subsingleton_info.mk s ss) :=
|
||
group ∘ cbrace $
|
||
when s "specialized" +++
|
||
when ss "subsingleton"
|
||
|
||
meta instance : has_to_format subsingleton_info :=
|
||
has_to_format.mk subsingleton_info_to_format
|
||
|
||
namespace tactic
|
||
|
||
/-- If nargs is not none, then return information assuming the function has only nargs arguments. -/
|
||
meta constant get_fun_info (f : expr) (nargs : option nat := none) (md := semireducible) : tactic fun_info
|
||
meta constant get_subsingleton_info (f : expr) (nargs : option nat := none) (md := semireducible) : tactic (list subsingleton_info)
|
||
|
||
/- (get_spec_subsingleton_info t) return subsingleton parameter
|
||
information for the function application t of the form
|
||
(f a_1 ... a_n).
|
||
This tactic is more precise than (get_subsingleton_info f) and (get_subsingleton_info_n f n)
|
||
|
||
Example: given (f : Pi (α : Type), α -> α), \c get_spec_subsingleton_info for
|
||
|
||
f unit b
|
||
|
||
returns a fun_info with two param_info
|
||
1) specialized = tt
|
||
2) is_subsingleton = tt
|
||
|
||
The second argument is marked as subsingleton only because the resulting information
|
||
is taking into account the first argument. -/
|
||
meta constant get_spec_subsingleton_info (t : expr) (md := semireducible) : tactic (list subsingleton_info)
|
||
meta constant get_spec_prefix_size (t : expr) (nargs : nat) (md := semireducible) : tactic nat
|
||
|
||
private meta def is_next_explicit : list param_info → bool
|
||
| [] := tt
|
||
| (p::ps) := bnot p^.is_implicit && bnot p^.is_inst_implicit
|
||
|
||
meta def fold_explicit_args_aux {α} (f : α → expr → tactic α) : list expr → list param_info → α → tactic α
|
||
| [] _ a := return a
|
||
| (e::es) ps a :=
|
||
if is_next_explicit ps
|
||
then f a e >>= fold_explicit_args_aux es ps^.tail
|
||
else fold_explicit_args_aux es ps^.tail a
|
||
|
||
meta def fold_explicit_args {α} (e : expr) (a : α) (f : α → expr → tactic α) : tactic α :=
|
||
if e^.is_app then do
|
||
info ← get_fun_info e^.get_app_fn (some e^.get_app_num_args),
|
||
fold_explicit_args_aux f e^.get_app_args info^.params a
|
||
else return a
|
||
|
||
end tactic
|