import data.list data.nat
open list nat

structure unification_constraint := {A : Type} (lhs : A) (rhs : A)
structure unification_hint := (pattern : unification_constraint) (constraints : list unification_constraint)

namespace toy
constants (A : Type.{1}) (f h : A → A) (x y z : A)
definition g [irreducible] (x y : A) : A := f z

#unify (g x y), (f z)

definition toy_hint [unify] (x y : A) : unification_hint :=
  unification_hint.mk (unification_constraint.mk (g x y) (f z)) []

#unify (g x y), (f z)
print [unify]

end toy

namespace add
constants (n : ℕ)
attribute add [irreducible]

#unify (n + 1), succ n

definition add_zero_hint [unify] (m n : ℕ) [has_add ℕ] [has_one ℕ] [has_zero ℕ] : unification_hint :=
  unification_hint.mk (unification_constraint.mk (m + 1) (succ n)) [unification_constraint.mk m n]

#unify (n + 1), (succ n)
print [unify]

end add

namespace canonical
inductive Canonical :=
mk : Π (carrier : Type) (op : carrier → carrier), Canonical

definition Canonical.carrier [irreducible] (s : Canonical) : Type :=
Canonical.rec_on s (λ c op, c)

constants (A : Type.{1}) (f : A → A) (x : A)
definition A_canonical : Canonical := Canonical.mk A f

#unify (Canonical.carrier A_canonical), A

definition Canonical_hint [unify] (C : Canonical) : unification_hint :=
  unification_hint.mk (unification_constraint.mk (Canonical.carrier C) A) [unification_constraint.mk C A_canonical]

-- TODO(dhs): we mark carrier as irreducible and prove A_canonical explicitly to work around the fact that
-- the default_type_context does not recognize the elaborator metavariables as metavariables,
-- and so cannot perform the assignment.
#unify (Canonical.carrier A_canonical), A
print [unify]

end canonical
