From 2485cf33fa390fee9632f595d55d2dc5ad1f5fe0 Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Thu, 7 Aug 2025 21:41:46 +0200
Subject: [PATCH 01/23] Close to working tabled type class

---
 apps/tc-tabled/theories/diamond.v           |  30 ++
 apps/tc-tabled/theories/tabled_type_class.v | 540 ++++++++++++++++++++
 2 files changed, 570 insertions(+)
 create mode 100644 apps/tc-tabled/theories/diamond.v
 create mode 100644 apps/tc-tabled/theories/tabled_type_class.v

diff --git a/apps/tc-tabled/theories/diamond.v b/apps/tc-tabled/theories/diamond.v
new file mode 100644
index 000000000..bb9e1ac68
--- /dev/null
+++ b/apps/tc-tabled/theories/diamond.v
@@ -0,0 +1,30 @@
+(* Diamond example in Rocq *)
+Class T (alpha : Type) (n : nat).
+Class R (alpha : Type) (n : nat).
+Class L (alpha : Type) (n : nat).
+Class B (alpha : Type) (n : nat).
+Instance BtL alpha n `{B alpha n} : L alpha n := {}.
+Instance BtR alpha n `{B alpha n} : R alpha n := {}.
+Instance LtR alpha n `{L alpha n} : T alpha n := {}.
+Instance RtR alpha n `{R alpha n} : T alpha n := {}.
+Instance TtR alpha n `{T alpha n} : B alpha (S n) := {}.
+
+Instance B0 alpha : B alpha 0 := {}.
+
+(* Finished transaction in 0.004 secs (0.004u,0.s) (successful) *)
+Module Test20. Time Instance TtR20 : B unit 20 := _. End Test20.
+
+(* Finished transaction in 1.372 secs (1.195u,0.03s) (successful) *)
+Module Test200. Time Instance TtR200 : B unit 200 := _. End Test200.
+
+(* Finished transaction in 4.842 secs (4.084u,0.147s) (successful) *)
+Module Test300. Time Instance TtR300 : B unit 300 := _. End Test300.
+
+(* Finished transaction in 23.508 secs (22.228u,0.258s) (successful) *)
+Module Test500. Time Instance TtR500 : B unit 500 := _. End Test500.
+
+(* Finished transaction in 31.622 secs (28.185u,0.517s) (successful) *)
+Module Test550. Time Instance TtR550 : B unit 550 := _. End Test550.
+
+(* Finished transaction in 31.622 secs (28.185u,0.517s) (successful) *)
+Module Test1000. Time Instance TtR1000 : B unit 1000 := _. End Test1000.
diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
new file mode 100644
index 000000000..e88533fbe
--- /dev/null
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -0,0 +1,540 @@
+From elpi Require Import elpi.
+From elpi.apps Require Import tc.
+
+#[arguments(raw)] Elpi Tactic TC.TabledSolver.
+Elpi TC Solver Register TC.TabledSolver.
+
+(* Tabled type class : https://github.com/purefunctor/tabled-typeclass-resolution?tab=readme-ov-file *)
+(* https://github.com/purefunctor/tabled-typeclass-resolution/blob/main/src/lib.rs *)
+(* ty = https://github.com/leanprover/lean4/blob/cade21/src/Lean/Expr.lean#L152-L165 *)
+(* Coq-Stlc: https://lpcic.github.io/coq-elpi/stlc.txt *) 
+Elpi Accumulate lp:{{
+  typeabbrev ty term.
+
+  kind data type.
+  type data ty -> list data -> data.
+
+  kind assertion type.
+  type assertion term -> term -> assertion.
+
+  kind consumer_node type.
+  type consumer_node assertion -> list assertion -> consumer_node.
+
+  kind waiter type.
+  type root waiter.
+  type callback consumer_node -> waiter.
+
+  kind entry type.
+  type entry list waiter -> list assertion -> entry.
+
+  typeabbrev resume_stack (list (pair consumer_node assertion)).
+
+  typeabbrev instance tc-instance.
+
+  kind class_instances type.
+  type class_instances std.map assertion (list instance) -> class_instances.
+
+  kind generator_node type.
+  type generator_node assertion -> list instance -> generator_node.
+
+  kind synth type.
+  type synth list generator_node ->
+    resume_stack ->
+    std.map assertion entry ->
+    option assertion ->
+    synth.
+}}.
+
+Elpi Accumulate lp:{{
+  pred type_equal i:ty i:ty o:cmp.
+  type_equal X Y eq :- 
+    coq.unify-eq X Y ok, !.
+  type_equal X Y lt :-
+    coq.unify-leq X Y ok, !.
+  type_equal _ _ gt.
+
+  pred assertion_equal i:assertion i:assertion o:cmp.
+  assertion_equal (assertion A _) (assertion B _) Cmp :-
+    coq.say "Assertions equal?" A B,
+    type_equal A B Cmp.
+
+  pred term_typeclass i:term o:gref.
+  term_typeclass (global Name) Name.
+  term_typeclass (app [X | _]) N :- term_typeclass X N.
+
+  pred assertion_typeclass i:assertion o:gref.
+  assertion_typeclass (assertion G _) Name :- term_typeclass G Name.
+}}.
+
+Elpi Accumulate lp:{{
+  pred new_subgoal i:synth i:assertion i:waiter o:synth.
+  new_subgoal
+    (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+    Subgoal Waiter
+    (synth NewGeneratorStack ResumeStack NewAssertionTable RootAnswer) :-
+    coq.say "Enter" Subgoal Waiter,
+    std.map.add Subgoal (entry [Waiter] []) AssertionTable NewAssertionTable,
+    coq.say "AssertionTable" NewAssertionTable,
+    assertion_typeclass Subgoal Name,
+    coq.TC.db-for Name Instances,
+    coq.say "New Subgoal" Name Instances,
+    NewGeneratorStack = [(generator_node Subgoal Instances) | GeneratorStack]
+    .
+}}.
+
+Elpi Accumulate lp:{{
+  pred temp_fun i:consumer_node i:assertion o:(pair consumer_node assertion).
+  temp_fun A B (pr A B).
+
+  pred waiter_fun i:assertion i:assertion i:waiter i:(pair (resume_stack) (option assertion)) o:(pair (resume_stack) (option assertion)).
+  waiter_fun Answer _ root (pr A _) (pr A (some Answer)) :- coq.say "Found answer" Answer.
+  waiter_fun _ Goal (callback C) (pr A R) (pr [pr C Goal | A] R) :- coq.say "Run Waiter".
+
+  pred new_consumer_node i:synth i:assertion i:consumer_node o:synth.
+  new_consumer_node
+      (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+      Answer
+      (consumer_node Goal [])
+      (synth GeneratorStack NewResumeStack NewAssertionTable NewRootAnswer) :-
+    coq.say "Empty node, keep waiters?" Goal "Table" AssertionTable,
+    /* for each solution to g, push new cnode onto resume stack with it */
+    std.map.find Goal AssertionTable (entry Waiters Answers),
+    coq.say "Found Goal",
+    /* add new cnode to g's dependents */
+    /* TODO: Add answer here! */
+    NewAnswers = [ Answer | Answers ],
+    coq.say "Fold and readd?",
+    /* for each solution to g, push new cnode onto resume stack with it */
+    std.fold Waiters (pr ResumeStack RootAnswer) (waiter_fun Answer Goal) (pr NewResumeStack NewRootAnswer),
+    /* add new cnode to g's dependents */
+    std.map.add Goal (entry Waiters NewAnswers) AssertionTable NewAssertionTable, /* TODO: [] or Waiters? */
+    coq.say "Success" NewAssertionTable.
+
+  new_consumer_node
+      (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+      _
+      CN
+      (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer) :-
+      CN = consumer_node _ [Subgoal | _ ],
+      coq.say "Consumer node" CN, /* TODO: Consumer node is general instead of variable or hole */
+      (((std.map.find Subgoal AssertionTable (entry Waiters Answers)),!,
+        (
+        coq.say "In map" Subgoal AssertionTable (entry Waiters Answers),
+        std.map Answers (temp_fun CN) TempResumeStack,
+        std.append TempResumeStack ResumeStack NewResumeStack,
+
+        NewWaiters = [ callback CN | Waiters ],
+        std.map.add Subgoal (entry NewWaiters Answers) AssertionTable NewAssertionTable,
+        NewGeneratorStack = GeneratorStack
+        ));
+       (
+        coq.say "Not in map" Subgoal AssertionTable,
+        new_subgoal
+           (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+           Subgoal
+           (callback CN)
+           (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer)
+        )
+      ),
+      coq.say "<- Success".
+
+    new_consumer_node _ _ _ _ :- coq.error "Failed new consumer node!" , fail.
+}}.
+
+Elpi Accumulate lp:{{
+  pred try_answer_type i:ty o:ty.
+  try_answer_type X Y :- coq.unify-eq X Y ok.
+
+  pred try_answer i:assertion o:assertion.
+  try_answer (assertion A _) (assertion B _) :-
+    coq.say "Try answer A" A "and B" B,
+    coq.unify-eq X Y ok.
+}}.
+
+Elpi Accumulate lp:{{
+  pred tc_instance_to_term i:tc-instance o:term.
+  tc_instance_to_term (tc-instance (const C) _) T :-
+    coq.env.const C Body Type,
+    coq.gref->string (const C) Name,
+    T = Type.
+
+  pred try_resolve_types i:term i:term i:term o:list assertion.
+  try_resolve_types A ATm (prod X T F) L :-
+    !,
+    ((T = app [ _ | _ ], !, L = [ assertion T NewV | LS ]) ; (L = LS)),
+    try_resolve_types A ATm (F V) LS,
+    coq.say "V" V,
+    coq.elaborate-skeleton V T NewV ok,
+    coq.say "NewV" NewV,
+    (ground_term V; coq.say "NOT GROUNHD" V)
+    .
+  try_resolve_types A ATm B [] :-
+    !,
+    @holes! ==> coq.unify-leq A B ok
+    .
+
+  pred try_resolve i:assertion i:instance o:list assertion.
+  try_resolve (assertion A ATm) (tc-instance BI _) RL :-
+    tc_instance_to_term (tc-instance BI _) B,
+    coq.env.global BI ATm,
+    coq.say "ATm" ATm,
+    try_resolve_types A ATm B RL
+    .
+}}.
+
+Elpi Query lp:{{
+  coq.unify-leq V {{ nat }} ok. 
+}}.
+
+Class R1 (X : Type) (Y : Type).
+Axiom A1 B1 C1 D1 : Type.
+Instance I1 : R1 A1 B1 := {}. 
+Instance I2 : R1 A1 C1 := {}. 
+Instance I3 : R1 C1 D1 := {}. 
+Instance I4 {X Y Z} `{R1 X Y} `{R1 Y Z} : R1 X Z := {}. 
+
+Elpi Query lp:{{
+  coq.TC.db-tc [ R | _ ],
+  coq.TC.db-for R [ _ , _ , _ , I4 ],
+  try_resolve (assertion {{ R1 A1 D1 }} {{ _ }}) I4 L,
+  coq.say {{ I4 }}, 
+  coq.say "L" L "vs" [ assertion {{ R1 A1 lp:{{X}} }} _ , assertion {{ R1 lp:{{X}} D1 }} {{ _ }} ],
+  L = [ assertion {{ R1 A1 _ }} _ , assertion {{ R1 _ D1 }} _ ],
+  coq.say "Subgoals" L.
+}}.
+
+Elpi Query lp:{{
+  coq.TC.db-tc [ R | _ ],
+  coq.TC.db-for R [ _ , _ , I1 , _ ],
+  try_resolve (assertion {{ R1 A1 B1 }} {{ _ }}) I1 L,
+  coq.say "Subgoals" L.
+}}.
+
+Elpi Accumulate lp:{{
+  pred tabled_typeclass_resolution_body i:synth i:assertion o:synth o:assertion.
+  tabled_typeclass_resolution_body (synth _ _ _ (some Answer)) _ _ Answer.
+
+  tabled_typeclass_resolution_body
+    (synth GeneratorStack [ (pr (consumer_node Goal [ Subgoal | Remaining ]) Answer) | ResumeStack ]
+       AssertionTable RootAnswer) Query MySynth FinalAnswer :-
+    coq.say "ResumeStack" Subgoal Answer,
+    (
+      (try_answer Subgoal Answer, !,
+       coq.say "Suceed try",
+       new_consumer_node
+         (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+         Answer
+         (consumer_node Goal Remaining) /* TODO: Was Goal in code, but should add new solution? */
+         MySynth
+      );
+      (
+        coq.say "Continues",
+        MySynth = (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+      )
+    ).
+
+  tabled_typeclass_resolution_body
+    (synth GeneratorStack [ (pr (consumer_node Goal []) Answer) | ResumeStack ]
+       AssertionTable RootAnswer) Query MySynth FinalAnswer :-
+   coq.say "Cannot resume with empty subgoals!",
+   fail.
+
+  tabled_typeclass_resolution_body
+    (synth [ generator_node Goal [Instance | Instances ] | GeneratorStack ]
+      ResumeStack AssertionTable RootAnswer) Query NewSynth FinalAnswer :-
+    (
+      (
+        /* else (l. 14) */
+        coq.say "Try to resolve" Goal Instance,
+        try_resolve Goal Instance Subgoals, !,
+        coq.say "Resolved" Subgoals,
+        /* Instance = instance Answer, */
+        (new_consumer_node
+          (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
+          Goal /* TODO: does not follow protocol! dummy value? */
+          (consumer_node Goal Subgoals) NewSynth), /* TODO: Should not be goal but answer? */
+        coq.say "No fall trhough"
+      );
+      (
+        /* If first subgoal of cnode does not resolve with solution then Continue */
+        coq.say "Fall through",
+        NewSynth = (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
+      )
+    ).
+
+  tabled_typeclass_resolution_body
+    (synth [ generator_node _ [] | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
+      Query
+      (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+      FinalAnswer.
+  /* If cnode has no remaining subgoals then (ll.7-13) .. */
+
+  tabled_typeclass_resolution_body (synth [] [] _ _) _ _ _ :- fail.
+}}.
+
+Elpi Accumulate lp:{{
+  pred synth_loop i:synth i:assertion i:int o:assertion.
+  synth_loop (synth _ _ _ (some Answer)) _ Fuel Answer.
+  synth_loop MySynth Query Fuel FinalAnswer :-
+    coq.say Fuel MySynth,
+    Fuel > 0,
+    tabled_typeclass_resolution_body MySynth Query NextSynth FinalAnswer,
+    !,
+    NextFuel is Fuel - 1,
+    synth_loop NextSynth Query NextFuel FinalAnswer.
+
+  pred tabled_typeclass_resolution i:assertion o:assertion.
+  tabled_typeclass_resolution Query FinalAnswer :-
+    coq.say "Query?" Query,
+    std.map.make assertion_equal AssertionTableEmpty,
+    new_subgoal (synth [] [] AssertionTableEmpty none) Query root MySynth,
+    /* while true do */
+    synth_loop MySynth Query 2000 FinalAnswer.
+}}.
+
+(*
+Class R (X : Type) (Y : Type).
+Axiom A B C D : Type.
+Instance I1 : R A B := {}. 
+Instance I2 : R A C := {}. 
+Instance I3 : R C D := {}. 
+Instance I4 {X Y Z} `{R X Y} `{R Y Z} : R X Z := {}. 
+ *)
+
+(* Trivial Example *)
+Elpi Query lp:{{ 
+  MyGoal = {{ R1 A1 B1 }},
+  tabled_typeclass_resolution (assertion MyGoal {{ _ }}) FinalAnswer,
+  coq.say "FinalAnswer" FinalAnswer.
+}}.
+
+(* Example from Paper *)
+Elpi Query lp:{{ 
+  MyGoal = {{ R1 A1 D1 }},
+  tabled_typeclass_resolution (assertion MyGoal {{ _ }}) FinalAnswer,
+  coq.say "FinalAnswer" FinalAnswer.
+}}.
+
+(* Example that should fail *)
+Axiom E : Type.
+(*,
+Elpi Query lp:{{
+  MyGoal = assertion {{ R A E }},
+  (tabled_typeclass_resolution MyGoal FinalAnswer),
+  coq.say "Finished" FinalAnswer.
+  not (tabled_typeclass_resolution MyGoal FinalAnswer),
+  coq.say "Finished" FinalAnswer.
+}}.
+ *)
+
+(* https://github.com/leanprover/lean4/blob/cade21/src/Lean/Meta/SynthInstance.lean *)
+(* https://github.com/leanprover/lean4/blob/master/tests/lean/run/typeclass_diamond.lean *)
+(* Diamond *)
+
+(*
+Elpi Query lp:{{
+  MyLInstances = [
+    instance (assertion "L" [ty_variable "alpha", ty_variable "n"] none) [assertion "B" [ty_variable "alpha", ty_variable "n"] none] ],
+
+  MyRInstances = [
+    instance (assertion "R" [ty_variable "alpha", ty_variable "n"] none) [assertion "B" [ty_variable "alpha", ty_variable "n"] none] ],
+
+  MyTInstances = [
+    instance (assertion "T" [ty_variable "alpha", ty_variable "n"] none) [assertion "L" [ty_variable "alpha", ty_variable "n"] none],
+    instance (assertion "T" [ty_variable "alpha", ty_variable "n"] none) [assertion "R" [ty_variable "alpha", ty_variable "n"] none] ],
+
+  MyBInstances = [
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "0"] none) [],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "1"] none) [assertion "T" [ty_variable "alpha", ty_constructor "0"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "2"] none) [assertion "T" [ty_variable "alpha", ty_constructor "1"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "3"] none) [assertion "T" [ty_variable "alpha", ty_constructor "2"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "4"] none) [assertion "T" [ty_variable "alpha", ty_constructor "3"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "5"] none) [assertion "T" [ty_variable "alpha", ty_constructor "4"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "6"] none) [assertion "T" [ty_variable "alpha", ty_constructor "5"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "7"] none) [assertion "T" [ty_variable "alpha", ty_constructor "6"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "8"] none) [assertion "T" [ty_variable "alpha", ty_constructor "7"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "9"] none) [assertion "T" [ty_variable "alpha", ty_constructor "8"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "10"] none) [assertion "T" [ty_variable "alpha", ty_constructor "9"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "11"] none) [assertion "T" [ty_variable "alpha", ty_constructor "10"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "12"] none) [assertion "T" [ty_variable "alpha", ty_constructor "11"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "13"] none) [assertion "T" [ty_variable "alpha", ty_constructor "12"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "14"] none) [assertion "T" [ty_variable "alpha", ty_constructor "13"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "15"] none) [assertion "T" [ty_variable "alpha", ty_constructor "14"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "16"] none) [assertion "T" [ty_variable "alpha", ty_constructor "15"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "17"] none) [assertion "T" [ty_variable "alpha", ty_constructor "16"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "18"] none) [assertion "T" [ty_variable "alpha", ty_constructor "17"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "19"] none) [assertion "T" [ty_variable "alpha", ty_constructor "18"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "20"] none) [assertion "T" [ty_variable "alpha", ty_constructor "19"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "21"] none) [assertion "T" [ty_variable "alpha", ty_constructor "20"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "22"] none) [assertion "T" [ty_variable "alpha", ty_constructor "21"] none],
+    instance (assertion "B" [ty_variable "alpha", ty_constructor "23"] none) [assertion "T" [ty_variable "alpha", ty_constructor "22"] none],
+  ],
+
+  std.map.make cmp_term ClassInstancesTemp1,
+  std.map.add "L" MyLInstances ClassInstancesTemp1 ClassInstancesTemp2,
+  std.map.add "R" MyRInstances ClassInstancesTemp2 ClassInstancesTemp3,
+  std.map.add "T" MyTInstances ClassInstancesTemp3 ClassInstancesTemp4,
+  std.map.add "B" MyBInstances ClassInstancesTemp4 ClassInstancesTemp5,
+  ClassInstances = ClassInstancesTemp5,
+
+  MyGoal = (assertion "T" [ty_constructor "Unit", ty_constructor "23"] none),
+
+  coq.say "Almost" MyGoal ClassInstances,
+  tabled_typeclass_resolution MyGoal ClassInstances FinalAnswer,
+  coq.say "Finished" FinalAnswer.
+}}.
+*)
+
+(* https://github.com/LPCIC/coq-elpi/blob/master/builtin-doc/coq-builtin.elpi *)
+Elpi Accumulate lp:{{
+  pred proof_search i:list gref i:list tc-instance i:term o:term.
+  proof_search Typeclasses [tc-instance Hd _ | _ ] Type PRoof :-
+    coq.env.typeof Hd TypeRes,
+    coq.env.global Hd ProofRes,
+    coq.say "CHECKING" TypeRes,
+    coq.unify-eq TypeRes Type D,
+    coq.say D,
+    D = ok,
+    % TypeRes = Type,
+    coq.say "SUCCESS",
+    PRoof = ProofRes.
+  proof_search Typeclasses [_|Tl] Type PRoof :-
+    proof_search Typeclasses Tl Type PRoof.
+}}.
+
+Elpi Accumulate lp:{{
+  pred tabled_proof_search i:list gref i:term o:term.
+  tabled_proof_search Typeclasses Type PRoof :-
+    coq.say "TYPECLASSES" Typeclasses,
+    coq.say "TYPE" Type,
+    /*
+    std.map.make cmp_term ClassInstancesTemp,
+    std.fold Typeclasses ClassInstancesTemp fold_class_instances ClassInstances, 
+    */
+    MyGoal = assertion Type {{ _ }},
+    /* term_to_assertion Type none MyGoal, /* MyGoal is Assertion */ */
+    coq.say "Goal" MyGoal,
+    coq.say "Attemp" MyGoal ClassInstances,
+    tabled_typeclass_resolution MyGoal FinalAnswer,
+    !,
+    coq.say "Final Answer" FinalAnswer,
+
+    /* TODO: Convert from result to proof term! */
+
+    FinalAnswer = assertion FinalType FinalTerm,
+    FinalProof = FinalTerm,
+    coq.say "FinalProof" FinalProof,
+    PRoof = FinalProof,
+    coq.say "Proof" PRoof,
+
+    coq.say "Done".
+
+
+  pred search_context i:list prop i:term o:term.
+  search_context [decl Te N Ty | _] Type PRoof :-
+    Ty = Type,
+    Te = PRoof,
+    coq.say "CHECK SUCC" N PRoof.
+  search_context [_|Tl] Type PRoof :- search_context Tl Type PRoof.
+
+  solve (goal Ctx Trigger Type PRoof Args as G) V :-
+    coq.TC.db-tc Typeclasses,
+    coq.say "AGRS" Args Ctx,
+    coq.say "SEARCHING ..." Type, !,
+    coq.say "V" V,
+    (search_context Ctx Type PRoof ; tabled_proof_search Typeclasses Type PRoof),
+    coq.say "SUCCESS FINDING INSTANCE".
+    
+
+  solve _ _ :- coq.ltac.fail _ "No auto".
+}}.
+
+Elpi TC Solver Activate TC.TabledSolver.
+Elpi TC Solver Override TC.TabledSolver All.
+
+Elpi Export TC.TabledSolver.
+
+(* Trivial test *)
+Class Constant := {}.
+Instance Con : Constant := {}.
+(* Instance TestConstant : Constant := _. *)
+
+(* Check holes *)
+Elpi Query lp:{{
+  /* {{ Instance TestConstant : Constant := _ }} */
+  coq.elaborate-skeleton {{ lib:elpi.hole }} {{ Constant }} V ok,
+  coq.say "Elaborates to" V.
+}}.
+
+(* Test instance dependency *)
+Class Dependency := {}.
+
+Instance Dep `{Constant} : Dependency := {}.
+
+Elpi Query lp:{{
+  /* {{ Instance TestConstant : Constant := _ }} */
+  coq.elaborate-skeleton {{ lib:elpi.hole }} {{ Constant }} V ok,
+  coq.say "Elaborates to" V.
+}}.
+
+(*
+Elpi Query lp:{{ 
+  coq.say "Dep" {{ Constant }},
+  coq.elaborate-skeleton {{ lib:elpi.hole }} {{ Constant }} _ ok, !,
+  coq.elaborate-skeleton {{ lib:elpi.hole }} {{ Dependency }} _ ok. 
+}}.
+*)
+
+(* Instance TestDependency : Dependency := _. *)
+
+(* Trivial test *)
+Class Argument (alpha : Type) := {}.
+Instance Arg : Argument unit := {}.
+Instance TestArgument : Argument unit := _.
+
+Instance AArg (alpha : Type) : Argument alpha := {}.
+(* Instance TestArgumentArg : Argument nat := _. *)
+
+(* Partial Simple Diamond example *)
+Class T (n : nat).
+Class R (n : nat).
+Class L (n : nat).
+Class B (n : nat).
+Instance BtL n `{B n} : L n := {}.
+Instance BtR n `{B n} : R n := {}.
+Instance LtR n `{L n} : T n := {}.
+Instance RtR n `{R n} : T n := {}.
+
+Instance B0 : B 0 := {}.
+
+Instance Test0 : B 0 := _.
+Instance Test100 : B 10 := _.
+
+(* Partial Diamond example *)
+Class T (alpha : Type) (n : nat).
+Class R (alpha : Type) (n : nat).
+Class L (alpha : Type) (n : nat).
+Class B (alpha : Type) (n : nat).
+Instance BtL alpha n `{B alpha n} : L alpha n := {}.
+Instance BtR alpha n `{B alpha n} : R alpha n := {}.
+Instance LtR alpha n `{L alpha n} : T alpha n := {}.
+Instance RtR alpha n `{R alpha n} : T alpha n := {}.
+
+Instance B0 alpha : B alpha 0 := {}.
+
+Instance Test0 : B unit 0 := _.
+
+(* Diamond example in Rocq *)
+Class T (alpha : Type) (n : nat).
+Class R (alpha : Type) (n : nat).
+Class L (alpha : Type) (n : nat).
+Class B (alpha : Type) (n : nat).
+Instance BtL alpha n `{B alpha n} : L alpha n := {}.
+Instance BtR alpha n `{B alpha n} : R alpha n := {}.
+Instance LtR alpha n `{L alpha n} : T alpha n := {}.
+Instance RtR alpha n `{R alpha n} : T alpha n := {}.
+Instance TtR alpha n `{T alpha n} : B alpha (S n) := {}.
+
+Instance B0 alpha : B alpha 0 := {}.
+
+Fail Instance TtR20 : B unit 20 := _.

From 47482e71d69520a152beb127efde584c39b85dbc Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Sun, 10 Aug 2025 19:51:57 +0200
Subject: [PATCH 02/23] Walk term structure for computation

---
 apps/tc-tabled/theories/tabled_type_class.v | 556 ++++++++++----------
 1 file changed, 282 insertions(+), 274 deletions(-)

diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index e88533fbe..59bf0c982 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -7,7 +7,8 @@ Elpi TC Solver Register TC.TabledSolver.
 (* Tabled type class : https://github.com/purefunctor/tabled-typeclass-resolution?tab=readme-ov-file *)
 (* https://github.com/purefunctor/tabled-typeclass-resolution/blob/main/src/lib.rs *)
 (* ty = https://github.com/leanprover/lean4/blob/cade21/src/Lean/Expr.lean#L152-L165 *)
-(* Coq-Stlc: https://lpcic.github.io/coq-elpi/stlc.txt *) 
+(* Coq-Stlc: https://lpcic.github.io/coq-elpi/stlc.txt *)
+(* https://github.com/leanprover/lean4/blob/master/src/Lean/Expr.lean#L302-L512 *)
 Elpi Accumulate lp:{{
   typeabbrev ty term.
 
@@ -47,20 +48,35 @@ Elpi Accumulate lp:{{
 
 Elpi Accumulate lp:{{
   pred type_equal i:ty i:ty o:cmp.
-  type_equal X Y eq :- 
-    coq.unify-eq X Y ok, !.
-  type_equal X Y lt :-
-    coq.unify-leq X Y ok, !.
-  type_equal _ _ gt.
+  type_equal X Y eq :- var X, var Y.
+  type_equal (app L) (app G) Cmp :- type_equal_list L G Cmp.
+  type_equal X Y lt :- var X, ground_term Y.
+  type_equal X Y gt :- ground_term X, var Y.
+  type_equal X Y Cmp :-
+    ground_term X,
+    ground_term Y,
+    cmp_term X Y Cmp.
+
+  pred type_equal_list i:list ty i:list ty o:cmp.
+/* std.map L (x\ y\ type_equal x y eq) G. */
+  type_equal_list [ X | XS ] [ Y | YS ] Cmp :-
+      type_equal X Y eq,
+      type_equal_list XS YS Cmp.
+  type_equal_list [ X | _ ] [ Y | _ ] Cmp :-
+      type_equal X Y Cmp,
+      not (Cmp = eq).
+  type_equal_list [] [] eq.
 
   pred assertion_equal i:assertion i:assertion o:cmp.
   assertion_equal (assertion A _) (assertion B _) Cmp :-
-    coq.say "Assertions equal?" A B,
+  /* coq.say "Assertions equal?" A B, */
     type_equal A B Cmp.
 
   pred term_typeclass i:term o:gref.
   term_typeclass (global Name) Name.
   term_typeclass (app [X | _]) N :- term_typeclass X N.
+  term_typeclass (prod X T F) N :-
+    pi x\ term_typeclass (F x) N.
 
   pred assertion_typeclass i:assertion o:gref.
   assertion_typeclass (assertion G _) Name :- term_typeclass G Name.
@@ -77,18 +93,207 @@ Elpi Accumulate lp:{{
     coq.say "AssertionTable" NewAssertionTable,
     assertion_typeclass Subgoal Name,
     coq.TC.db-for Name Instances,
-    coq.say "New Subgoal" Name Instances,
+    /* coq.say "New Subgoal" Name Instances, */
     NewGeneratorStack = [(generator_node Subgoal Instances) | GeneratorStack]
     .
 }}.
 
+(* Apply answer to goal and update meta variable context if it succeeds *)
+Elpi Accumulate lp:{{
+  pred replace_var_term i:ty o:ty i:ty o:ty.
+  replace_var_term X Y Z W :- coq.say "Replace" X Y Z W, fail.
+  replace_var_term X Y (app L) (app G) :-
+    std.map L (replace_var_term X Y) G.
+  replace_var_term X Y Z W :-
+    var Z,
+    X == Z,
+    W = Y
+    .
+  replace_var_term X Y Z Z.
+
+  pred replace_var_in_list i:ty o:ty i:list assertion o:list assertion.
+  replace_var_in_list X Y [ assertion TA VA | AS ] [ assertion TB VB | BS ] :-
+      coq.say "Try" X Y TA,
+      replace_var_term X Y TA TB,
+      coq.say "Replaced" TB AS,
+      /* replace_var_term X Y VA VB, */
+      replace_var_in_list X Y AS BS.
+  replace_var_in_list _ _ [] [].
+
+
+  pred try_answer_type i:ty o:ty i:list assertion o:list assertion.
+  try_answer_type X Y Lin Lout :-
+    var X, var Y, replace_var_in_list X Y Lin Lout.
+  try_answer_type (app L) (app G) Lin Lout :-
+    try_answer_type_list L G Lin Lout.
+  try_answer_type X Y Lin Lout :-
+    var X, ground_term Y, replace_var_in_list X Y Lin Lout.
+  try_answer_type X Y L L :-
+    ground_term X,
+    ground_term Y,
+    cmp_term X Y eq.
+
+  pred try_answer_type_list i:list ty o:list ty i:list assertion o:list assertion.
+  try_answer_type_list [ X | XS ] [ Y | YS ] Lin Lout :-
+      try_answer_type X Y Lin Ltemp,
+      try_answer_type_list XS YS Ltemp Lout.
+  try_answer_type_list [] [] L L.
+
+  pred try_answer i:assertion o:assertion i:list assertion o:list assertion.
+  try_answer (assertion A _) (assertion B _) Lin Lout :-
+    coq.say "Try answer",
+    coq.say "A" A,
+    coq.say "B" B,
+    try_answer_type A B Lin Lout.
+}}.
+
+Elpi Accumulate lp:{{
+  pred replace_list i:list term i:term i:term o:list term.
+  replace_list [ A | XS ] A B [ B | YS ] :-
+      !,
+      replace_list XS A B YS.
+  replace_list [ C | XS ] A B [ C | YS ] :-
+      replace_list XS A B YS.
+  replace_list [] _ _ [].
+
+  pred extract_helper i:term i:int i:term o:term.
+  extract_helper X Index (prod N T F) (prod N T G) :-
+    !,
+    pi x\
+      extract_helper X Index (F x) (G x).
+  extract_helper X Index (app L) (app NewL) :-
+    !,
+    std.split-at Index L Lfront [ V | Ltail ],
+    replace_list L V X NewL.
+
+  pred is_var_at_index i:term i:int.
+  is_var_at_index (prod N T F) I :-
+    pi x\
+      is_var_at_index (F x) I.
+  is_var_at_index (app L) I :-
+    std.split-at I L Lfront [ T | Ltail],
+    var T.
+
+  pred extract_variables i:list term i:int o:term.
+    extract_variables L -1 (app L).
+  extract_variables L Index Tm :-
+    PrevIndex is Index - 1,
+    extract_variables L PrevIndex PrevTm,
+    !,
+    ((is_var_at_index PrevTm Index,
+     Tm = prod TmX TmT TmF,
+     pi x\
+       extract_helper x Index PrevTm (TmF x)
+    );
+    (Tm = PrevTm))
+    .
+
+  pred re_generalize i:list term o:list term.
+  re_generalize [ X | Tl ] R :-
+    coq.typecheck X T ok,
+    (
+      (T = (app Tlist),
+       std.length Tlist Len,
+       Index is Len - 1,
+       extract_variables Tlist Index NewR,
+       R = [ NewR | RTl ],
+       coq.say "NewR" NewR
+       );
+      (R = RTl)
+    ),
+    re_generalize Tl RTl
+    .
+  re_generalize [ X | Tl ] [] :-
+    re_generalize Tl R.
+  re_generalize [ ] [].
+}}.
+
+
+Elpi Accumulate lp:{{
+  pred tc_instance_to_term i:tc-instance o:term.
+  tc_instance_to_term (tc-instance (const C) _) T :-
+    coq.env.const C _ /* Body */ Type,
+    coq.gref->string (const C) _ /* Name */,
+    T = Type.
+
+  pred does_type_resolve i:term o:term.
+  does_type_resolve X Y :-
+    var X.
+  does_type_resolve (app L) (app G) :-
+    std.map L does_type_resolve G.
+  does_type_resolve X Y :-
+    ground_term X,
+    X = Y.
+
+  pred try_resolve_types i:term i:term o:list term o:list term.
+  try_resolve_types A (prod X T F) OL L :-
+    !,
+    coq.typecheck V T ok,
+    try_resolve_types A (F V) OLS LS,
+    (OL = [ V | OLS]),
+    ((ground_term T, L = LS) ; L = [ T | LS ])
+    .
+  try_resolve_types A B [] [] :-
+    /* @holes! ==> coq.unify-leq B A ok */
+    does_type_resolve A B
+    /* type_equal A B lt */
+    /* cmp_term A B eq */
+    /* @holes! ==> pattern_match A B */
+    /* @holes! ==> coq.unify-leq B A ok */
+    .
+}}.
+
+Elpi Accumulate lp:{{
+  pred helper_fn i:term o:assertion.
+  helper_fn A (assertion A V).
+
+  pred simpl i:term o:term.
+  simpl (app [ prod X T F , Arg | Tl ]) R :-
+    simpl (app [ (F Arg) | Tl ]) R.
+  simpl (app [ A ]) A.
+  simpl A A.
+
+  pred filter_metavariables i:list term o:list term.
+  filter_metavariables [ (app L) | XS ] [ app L | YS ] :-
+      !, filter_metavariables XS YS.
+  filter_metavariables [ X | XS ] YS :-
+      filter_metavariables XS YS.
+  filter_metavariables [] [].
+
+
+  pred try_resolve i:assertion i:instance o:assertion o:list assertion.
+  try_resolve (assertion A _) (tc-instance BI _) (assertion RT RV) RL :-
+    tc_instance_to_term (tc-instance BI _) B,
+    coq.env.global BI BITm,
+    coq.gref->string BI BIName,
+    BI = const (BIConst),
+    coq.env.const BIConst (some BIBody) BITy,
+    coq.say "Try resolve types" A B,
+    try_resolve_types A B OL L,
+    /* coq.say "regeneralize" OL L, */
+    /* re_generalize L LR, */
+    /* coq.say "generalized" LR, */
+    filter_metavariables L LR,
+    !,
+    (std.map LR helper_fn RL),
+    coq.say "RL" RL,
+    RT = A, /* app [ B | OL ], */
+    ((OL = [], RV = BITm) ; RV = app [ BITm | OL ]),
+    coq.say "Result" RT RV "for" A
+
+    /* ATm = app [ B | OL ],
+        simpl ATm ATmRed */
+    .
+}}.
+
 Elpi Accumulate lp:{{
   pred temp_fun i:consumer_node i:assertion o:(pair consumer_node assertion).
   temp_fun A B (pr A B).
 
   pred waiter_fun i:assertion i:assertion i:waiter i:(pair (resume_stack) (option assertion)) o:(pair (resume_stack) (option assertion)).
-  waiter_fun Answer _ root (pr A _) (pr A (some Answer)) :- coq.say "Found answer" Answer.
-  waiter_fun _ Goal (callback C) (pr A R) (pr [pr C Goal | A] R) :- coq.say "Run Waiter".
+  waiter_fun Answer _ root (pr A _) (pr A (some Answer)) :-
+    coq.say "Found answer" Answer.
+waiter_fun Answer _ (callback C) (pr A R) (pr [pr C Answer /* Goal */ | A] R) :- coq.say "Run Waiter".
 
   pred new_consumer_node i:synth i:assertion i:consumer_node o:synth.
   new_consumer_node
@@ -96,120 +301,43 @@ Elpi Accumulate lp:{{
       Answer
       (consumer_node Goal [])
       (synth GeneratorStack NewResumeStack NewAssertionTable NewRootAnswer) :-
-    coq.say "Empty node, keep waiters?" Goal "Table" AssertionTable,
     /* for each solution to g, push new cnode onto resume stack with it */
     std.map.find Goal AssertionTable (entry Waiters Answers),
-    coq.say "Found Goal",
     /* add new cnode to g's dependents */
     /* TODO: Add answer here! */
     NewAnswers = [ Answer | Answers ],
-    coq.say "Fold and readd?",
     /* for each solution to g, push new cnode onto resume stack with it */
     std.fold Waiters (pr ResumeStack RootAnswer) (waiter_fun Answer Goal) (pr NewResumeStack NewRootAnswer),
     /* add new cnode to g's dependents */
-    std.map.add Goal (entry Waiters NewAnswers) AssertionTable NewAssertionTable, /* TODO: [] or Waiters? */
-    coq.say "Success" NewAssertionTable.
+    std.map.add Goal (entry Waiters NewAnswers) AssertionTable NewAssertionTable /* TODO: [] or Waiters? */.
 
   new_consumer_node
       (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
       _
       CN
       (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer) :-
-      CN = consumer_node _ [Subgoal | _ ],
-      coq.say "Consumer node" CN, /* TODO: Consumer node is general instead of variable or hole */
-      (((std.map.find Subgoal AssertionTable (entry Waiters Answers)),!,
-        (
-        coq.say "In map" Subgoal AssertionTable (entry Waiters Answers),
-        std.map Answers (temp_fun CN) TempResumeStack,
-        std.append TempResumeStack ResumeStack NewResumeStack,
-
-        NewWaiters = [ callback CN | Waiters ],
-        std.map.add Subgoal (entry NewWaiters Answers) AssertionTable NewAssertionTable,
-        NewGeneratorStack = GeneratorStack
-        ));
-       (
-        coq.say "Not in map" Subgoal AssertionTable,
-        new_subgoal
-           (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-           Subgoal
-           (callback CN)
-           (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer)
-        )
-      ),
-      coq.say "<- Success".
+      CN = consumer_node _ [ Subgoal | _ ],
+      /* TODO: Consumer node is general instead of variable or hole */
+      if (std.map.find Subgoal AssertionTable (entry Waiters Answers))
+         (
+          std.map Answers (temp_fun CN) TempResumeStack,
+          std.append TempResumeStack ResumeStack NewResumeStack,
+
+          NewWaiters = [ callback CN | Waiters ],
+          std.map.add Subgoal (entry NewWaiters Answers) AssertionTable NewAssertionTable,
+          NewGeneratorStack = GeneratorStack
+         )
+         (
+          new_subgoal
+            (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+            Subgoal
+            (callback CN)
+            (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer)
+        ).
 
     new_consumer_node _ _ _ _ :- coq.error "Failed new consumer node!" , fail.
 }}.
 
-Elpi Accumulate lp:{{
-  pred try_answer_type i:ty o:ty.
-  try_answer_type X Y :- coq.unify-eq X Y ok.
-
-  pred try_answer i:assertion o:assertion.
-  try_answer (assertion A _) (assertion B _) :-
-    coq.say "Try answer A" A "and B" B,
-    coq.unify-eq X Y ok.
-}}.
-
-Elpi Accumulate lp:{{
-  pred tc_instance_to_term i:tc-instance o:term.
-  tc_instance_to_term (tc-instance (const C) _) T :-
-    coq.env.const C Body Type,
-    coq.gref->string (const C) Name,
-    T = Type.
-
-  pred try_resolve_types i:term i:term i:term o:list assertion.
-  try_resolve_types A ATm (prod X T F) L :-
-    !,
-    ((T = app [ _ | _ ], !, L = [ assertion T NewV | LS ]) ; (L = LS)),
-    try_resolve_types A ATm (F V) LS,
-    coq.say "V" V,
-    coq.elaborate-skeleton V T NewV ok,
-    coq.say "NewV" NewV,
-    (ground_term V; coq.say "NOT GROUNHD" V)
-    .
-  try_resolve_types A ATm B [] :-
-    !,
-    @holes! ==> coq.unify-leq A B ok
-    .
-
-  pred try_resolve i:assertion i:instance o:list assertion.
-  try_resolve (assertion A ATm) (tc-instance BI _) RL :-
-    tc_instance_to_term (tc-instance BI _) B,
-    coq.env.global BI ATm,
-    coq.say "ATm" ATm,
-    try_resolve_types A ATm B RL
-    .
-}}.
-
-Elpi Query lp:{{
-  coq.unify-leq V {{ nat }} ok. 
-}}.
-
-Class R1 (X : Type) (Y : Type).
-Axiom A1 B1 C1 D1 : Type.
-Instance I1 : R1 A1 B1 := {}. 
-Instance I2 : R1 A1 C1 := {}. 
-Instance I3 : R1 C1 D1 := {}. 
-Instance I4 {X Y Z} `{R1 X Y} `{R1 Y Z} : R1 X Z := {}. 
-
-Elpi Query lp:{{
-  coq.TC.db-tc [ R | _ ],
-  coq.TC.db-for R [ _ , _ , _ , I4 ],
-  try_resolve (assertion {{ R1 A1 D1 }} {{ _ }}) I4 L,
-  coq.say {{ I4 }}, 
-  coq.say "L" L "vs" [ assertion {{ R1 A1 lp:{{X}} }} _ , assertion {{ R1 lp:{{X}} D1 }} {{ _ }} ],
-  L = [ assertion {{ R1 A1 _ }} _ , assertion {{ R1 _ D1 }} _ ],
-  coq.say "Subgoals" L.
-}}.
-
-Elpi Query lp:{{
-  coq.TC.db-tc [ R | _ ],
-  coq.TC.db-for R [ _ , _ , I1 , _ ],
-  try_resolve (assertion {{ R1 A1 B1 }} {{ _ }}) I1 L,
-  coq.say "Subgoals" L.
-}}.
-
 Elpi Accumulate lp:{{
   pred tabled_typeclass_resolution_body i:synth i:assertion o:synth o:assertion.
   tabled_typeclass_resolution_body (synth _ _ _ (some Answer)) _ _ Answer.
@@ -218,20 +346,25 @@ Elpi Accumulate lp:{{
     (synth GeneratorStack [ (pr (consumer_node Goal [ Subgoal | Remaining ]) Answer) | ResumeStack ]
        AssertionTable RootAnswer) Query MySynth FinalAnswer :-
     coq.say "ResumeStack" Subgoal Answer,
-    (
-      (try_answer Subgoal Answer, !,
-       coq.say "Suceed try",
-       new_consumer_node
+    Answer = assertion AnswerT AnswerV,
+    coq.typecheck AnswerV AnswerNT ok,
+    NewAnswer = assertion AnswerNT AnswerV,
+    (ground_term Answer; coq.say "Not ground answer"), /* TODO: Should answer be ground? */
+    if (try_answer Subgoal NewAnswer Remaining UpdatedRemaining)
+       (coq.say "Suceed try" Remaining,
+       /* TODO: Update Remaining with unification from try_answer ! */
+       /* keep goal? clone? */
+        coq.say "Actual" Subgoal,
+        new_consumer_node
          (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-         Answer
-         (consumer_node Goal Remaining) /* TODO: Was Goal in code, but should add new solution? */
+         NewAnswer
+         (consumer_node Goal UpdatedRemaining) /* TODO: Was Goal in code, but should add new solution? */
          MySynth
-      );
+      )
       (
         coq.say "Continues",
         MySynth = (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-      )
-    ).
+      ).
 
   tabled_typeclass_resolution_body
     (synth GeneratorStack [ (pr (consumer_node Goal []) Answer) | ResumeStack ]
@@ -242,25 +375,22 @@ Elpi Accumulate lp:{{
   tabled_typeclass_resolution_body
     (synth [ generator_node Goal [Instance | Instances ] | GeneratorStack ]
       ResumeStack AssertionTable RootAnswer) Query NewSynth FinalAnswer :-
-    (
-      (
+    if (try_resolve Goal Instance Resolved Subgoals)
+        (
         /* else (l. 14) */
-        coq.say "Try to resolve" Goal Instance,
-        try_resolve Goal Instance Subgoals, !,
-        coq.say "Resolved" Subgoals,
-        /* Instance = instance Answer, */
+        coq.say "Resolved" Resolved "Subgoals" Subgoals,
+        (ground_term Resolved ; coq.say "Resolved not ground"),
         (new_consumer_node
           (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
-          Goal /* TODO: does not follow protocol! dummy value? */
+          Resolved /* TODO: does not follow protocol! dummy value? */
           (consumer_node Goal Subgoals) NewSynth), /* TODO: Should not be goal but answer? */
         coq.say "No fall trhough"
-      );
-      (
+        )
+        (
         /* If first subgoal of cnode does not resolve with solution then Continue */
         coq.say "Fall through",
         NewSynth = (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
-      )
-    ).
+      ).
 
   tabled_typeclass_resolution_body
     (synth [ generator_node _ [] | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
@@ -276,7 +406,8 @@ Elpi Accumulate lp:{{
   pred synth_loop i:synth i:assertion i:int o:assertion.
   synth_loop (synth _ _ _ (some Answer)) _ Fuel Answer.
   synth_loop MySynth Query Fuel FinalAnswer :-
-    coq.say Fuel MySynth,
+    MySynth = synth Stack1 Stack2 _ _,
+    coq.say Fuel Stack2 Stack1,
     Fuel > 0,
     tabled_typeclass_resolution_body MySynth Query NextSynth FinalAnswer,
     !,
@@ -289,30 +420,37 @@ Elpi Accumulate lp:{{
     std.map.make assertion_equal AssertionTableEmpty,
     new_subgoal (synth [] [] AssertionTableEmpty none) Query root MySynth,
     /* while true do */
-    synth_loop MySynth Query 2000 FinalAnswer.
+    synth_loop MySynth Query 2000 FinalAnswer,
+    !.
 }}.
 
-(*
-Class R (X : Type) (Y : Type).
-Axiom A B C D : Type.
-Instance I1 : R A B := {}. 
-Instance I2 : R A C := {}. 
-Instance I3 : R C D := {}. 
-Instance I4 {X Y Z} `{R X Y} `{R Y Z} : R X Z := {}. 
- *)
+Class R1 (X : Type) (Y : Type).
+Axiom A1 B1 C1 D1 : Type.
+Instance I3 : R1 C1 D1 := {}.
+Instance I2 : R1 A1 C1 := {}.
+Instance I1 : R1 A1 B1 := {}.
+Instance I4 {X Y Z} `(R1 X Y) `(R1 Y Z) : R1 X Z := { }.
 
 (* Trivial Example *)
-Elpi Query lp:{{ 
+Elpi Query lp:{{
   MyGoal = {{ R1 A1 B1 }},
-  tabled_typeclass_resolution (assertion MyGoal {{ _ }}) FinalAnswer,
-  coq.say "FinalAnswer" FinalAnswer.
+  tabled_typeclass_resolution (assertion MyGoal {{ lib:elpi.hole }}) (assertion FinalType FinalAnswer),
+  FinalType = MyGoal,
+  coq.say "FinalAnswer" FinalType FinalAnswer,
+  coq.typecheck FinalAnswer MyGoal ok.
 }}.
 
 (* Example from Paper *)
-Elpi Query lp:{{ 
+Elpi Query lp:{{
   MyGoal = {{ R1 A1 D1 }},
-  tabled_typeclass_resolution (assertion MyGoal {{ _ }}) FinalAnswer,
-  coq.say "FinalAnswer" FinalAnswer.
+  coq.say "MyGoal" (assertion MyGoal {{ lib:elpi.hole }}),
+  tabled_typeclass_resolution (assertion MyGoal {{ lib:elpi.hole }}) (assertion FinalType FinalAnswer),
+  !,
+  coq.say "FinalAnswer" FinalType FinalAnswer "vs" {{ @I4 A1 D1 C1 I2 I3 }} {{ I4 _ _ }},
+  FinalAnswer = MyGoal,
+  coq.typecheck FinalAnswer MyGoal ok,
+  /* TODO: Currently fails here, recreation of terms is incorrect */
+  ground_term FinalAnswer.
 }}.
 
 (* Example that should fail *)
@@ -329,62 +467,6 @@ Elpi Query lp:{{
 
 (* https://github.com/leanprover/lean4/blob/cade21/src/Lean/Meta/SynthInstance.lean *)
 (* https://github.com/leanprover/lean4/blob/master/tests/lean/run/typeclass_diamond.lean *)
-(* Diamond *)
-
-(*
-Elpi Query lp:{{
-  MyLInstances = [
-    instance (assertion "L" [ty_variable "alpha", ty_variable "n"] none) [assertion "B" [ty_variable "alpha", ty_variable "n"] none] ],
-
-  MyRInstances = [
-    instance (assertion "R" [ty_variable "alpha", ty_variable "n"] none) [assertion "B" [ty_variable "alpha", ty_variable "n"] none] ],
-
-  MyTInstances = [
-    instance (assertion "T" [ty_variable "alpha", ty_variable "n"] none) [assertion "L" [ty_variable "alpha", ty_variable "n"] none],
-    instance (assertion "T" [ty_variable "alpha", ty_variable "n"] none) [assertion "R" [ty_variable "alpha", ty_variable "n"] none] ],
-
-  MyBInstances = [
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "0"] none) [],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "1"] none) [assertion "T" [ty_variable "alpha", ty_constructor "0"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "2"] none) [assertion "T" [ty_variable "alpha", ty_constructor "1"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "3"] none) [assertion "T" [ty_variable "alpha", ty_constructor "2"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "4"] none) [assertion "T" [ty_variable "alpha", ty_constructor "3"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "5"] none) [assertion "T" [ty_variable "alpha", ty_constructor "4"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "6"] none) [assertion "T" [ty_variable "alpha", ty_constructor "5"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "7"] none) [assertion "T" [ty_variable "alpha", ty_constructor "6"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "8"] none) [assertion "T" [ty_variable "alpha", ty_constructor "7"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "9"] none) [assertion "T" [ty_variable "alpha", ty_constructor "8"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "10"] none) [assertion "T" [ty_variable "alpha", ty_constructor "9"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "11"] none) [assertion "T" [ty_variable "alpha", ty_constructor "10"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "12"] none) [assertion "T" [ty_variable "alpha", ty_constructor "11"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "13"] none) [assertion "T" [ty_variable "alpha", ty_constructor "12"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "14"] none) [assertion "T" [ty_variable "alpha", ty_constructor "13"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "15"] none) [assertion "T" [ty_variable "alpha", ty_constructor "14"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "16"] none) [assertion "T" [ty_variable "alpha", ty_constructor "15"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "17"] none) [assertion "T" [ty_variable "alpha", ty_constructor "16"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "18"] none) [assertion "T" [ty_variable "alpha", ty_constructor "17"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "19"] none) [assertion "T" [ty_variable "alpha", ty_constructor "18"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "20"] none) [assertion "T" [ty_variable "alpha", ty_constructor "19"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "21"] none) [assertion "T" [ty_variable "alpha", ty_constructor "20"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "22"] none) [assertion "T" [ty_variable "alpha", ty_constructor "21"] none],
-    instance (assertion "B" [ty_variable "alpha", ty_constructor "23"] none) [assertion "T" [ty_variable "alpha", ty_constructor "22"] none],
-  ],
-
-  std.map.make cmp_term ClassInstancesTemp1,
-  std.map.add "L" MyLInstances ClassInstancesTemp1 ClassInstancesTemp2,
-  std.map.add "R" MyRInstances ClassInstancesTemp2 ClassInstancesTemp3,
-  std.map.add "T" MyTInstances ClassInstancesTemp3 ClassInstancesTemp4,
-  std.map.add "B" MyBInstances ClassInstancesTemp4 ClassInstancesTemp5,
-  ClassInstances = ClassInstancesTemp5,
-
-  MyGoal = (assertion "T" [ty_constructor "Unit", ty_constructor "23"] none),
-
-  coq.say "Almost" MyGoal ClassInstances,
-  tabled_typeclass_resolution MyGoal ClassInstances FinalAnswer,
-  coq.say "Finished" FinalAnswer.
-}}.
-*)
-
 (* https://github.com/LPCIC/coq-elpi/blob/master/builtin-doc/coq-builtin.elpi *)
 Elpi Accumulate lp:{{
   pred proof_search i:list gref i:list tc-instance i:term o:term.
@@ -409,7 +491,7 @@ Elpi Accumulate lp:{{
     coq.say "TYPE" Type,
     /*
     std.map.make cmp_term ClassInstancesTemp,
-    std.fold Typeclasses ClassInstancesTemp fold_class_instances ClassInstances, 
+    std.fold Typeclasses ClassInstancesTemp fold_class_instances ClassInstances,
     */
     MyGoal = assertion Type {{ _ }},
     /* term_to_assertion Type none MyGoal, /* MyGoal is Assertion */ */
@@ -444,7 +526,6 @@ Elpi Accumulate lp:{{
     coq.say "V" V,
     (search_context Ctx Type PRoof ; tabled_proof_search Typeclasses Type PRoof),
     coq.say "SUCCESS FINDING INSTANCE".
-    
 
   solve _ _ :- coq.ltac.fail _ "No auto".
 }}.
@@ -457,7 +538,6 @@ Elpi Export TC.TabledSolver.
 (* Trivial test *)
 Class Constant := {}.
 Instance Con : Constant := {}.
-(* Instance TestConstant : Constant := _. *)
 
 (* Check holes *)
 Elpi Query lp:{{
@@ -465,76 +545,4 @@ Elpi Query lp:{{
   coq.elaborate-skeleton {{ lib:elpi.hole }} {{ Constant }} V ok,
   coq.say "Elaborates to" V.
 }}.
-
-(* Test instance dependency *)
-Class Dependency := {}.
-
-Instance Dep `{Constant} : Dependency := {}.
-
-Elpi Query lp:{{
-  /* {{ Instance TestConstant : Constant := _ }} */
-  coq.elaborate-skeleton {{ lib:elpi.hole }} {{ Constant }} V ok,
-  coq.say "Elaborates to" V.
-}}.
-
-(*
-Elpi Query lp:{{ 
-  coq.say "Dep" {{ Constant }},
-  coq.elaborate-skeleton {{ lib:elpi.hole }} {{ Constant }} _ ok, !,
-  coq.elaborate-skeleton {{ lib:elpi.hole }} {{ Dependency }} _ ok. 
-}}.
-*)
-
-(* Instance TestDependency : Dependency := _. *)
-
-(* Trivial test *)
-Class Argument (alpha : Type) := {}.
-Instance Arg : Argument unit := {}.
-Instance TestArgument : Argument unit := _.
-
-Instance AArg (alpha : Type) : Argument alpha := {}.
-(* Instance TestArgumentArg : Argument nat := _. *)
-
-(* Partial Simple Diamond example *)
-Class T (n : nat).
-Class R (n : nat).
-Class L (n : nat).
-Class B (n : nat).
-Instance BtL n `{B n} : L n := {}.
-Instance BtR n `{B n} : R n := {}.
-Instance LtR n `{L n} : T n := {}.
-Instance RtR n `{R n} : T n := {}.
-
-Instance B0 : B 0 := {}.
-
-Instance Test0 : B 0 := _.
-Instance Test100 : B 10 := _.
-
-(* Partial Diamond example *)
-Class T (alpha : Type) (n : nat).
-Class R (alpha : Type) (n : nat).
-Class L (alpha : Type) (n : nat).
-Class B (alpha : Type) (n : nat).
-Instance BtL alpha n `{B alpha n} : L alpha n := {}.
-Instance BtR alpha n `{B alpha n} : R alpha n := {}.
-Instance LtR alpha n `{L alpha n} : T alpha n := {}.
-Instance RtR alpha n `{R alpha n} : T alpha n := {}.
-
-Instance B0 alpha : B alpha 0 := {}.
-
-Instance Test0 : B unit 0 := _.
-
-(* Diamond example in Rocq *)
-Class T (alpha : Type) (n : nat).
-Class R (alpha : Type) (n : nat).
-Class L (alpha : Type) (n : nat).
-Class B (alpha : Type) (n : nat).
-Instance BtL alpha n `{B alpha n} : L alpha n := {}.
-Instance BtR alpha n `{B alpha n} : R alpha n := {}.
-Instance LtR alpha n `{L alpha n} : T alpha n := {}.
-Instance RtR alpha n `{R alpha n} : T alpha n := {}.
-Instance TtR alpha n `{T alpha n} : B alpha (S n) := {}.
-
-Instance B0 alpha : B alpha 0 := {}.
-
-Fail Instance TtR20 : B unit 20 := _.
+Instance TestConstant : Constant := _.

From 6a602bca2bb65d7e4522a10ce057d448eab76398 Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Sun, 10 Aug 2025 22:19:25 +0200
Subject: [PATCH 03/23] Working example from paper with backtracking

---
 apps/tc-tabled/theories/tabled_type_class.v | 153 ++++++++++++--------
 1 file changed, 92 insertions(+), 61 deletions(-)

diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index 59bf0c982..5c8ffd1d6 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -67,6 +67,7 @@ Elpi Accumulate lp:{{
       not (Cmp = eq).
   type_equal_list [] [] eq.
 
+
   pred assertion_equal i:assertion i:assertion o:cmp.
   assertion_equal (assertion A _) (assertion B _) Cmp :-
   /* coq.say "Assertions equal?" A B, */
@@ -82,6 +83,7 @@ Elpi Accumulate lp:{{
   assertion_typeclass (assertion G _) Name :- term_typeclass G Name.
 }}.
 
+
 Elpi Accumulate lp:{{
   pred new_subgoal i:synth i:assertion i:waiter o:synth.
   new_subgoal
@@ -101,7 +103,6 @@ Elpi Accumulate lp:{{
 (* Apply answer to goal and update meta variable context if it succeeds *)
 Elpi Accumulate lp:{{
   pred replace_var_term i:ty o:ty i:ty o:ty.
-  replace_var_term X Y Z W :- coq.say "Replace" X Y Z W, fail.
   replace_var_term X Y (app L) (app G) :-
     std.map L (replace_var_term X Y) G.
   replace_var_term X Y Z W :-
@@ -113,38 +114,40 @@ Elpi Accumulate lp:{{
 
   pred replace_var_in_list i:ty o:ty i:list assertion o:list assertion.
   replace_var_in_list X Y [ assertion TA VA | AS ] [ assertion TB VB | BS ] :-
-      coq.say "Try" X Y TA,
       replace_var_term X Y TA TB,
-      coq.say "Replaced" TB AS,
-      /* replace_var_term X Y VA VB, */
+      replace_var_term X Y VA VB,
       replace_var_in_list X Y AS BS.
   replace_var_in_list _ _ [] [].
 
-
-  pred try_answer_type i:ty o:ty i:list assertion o:list assertion.
-  try_answer_type X Y Lin Lout :-
-    var X, var Y, replace_var_in_list X Y Lin Lout.
-  try_answer_type (app L) (app G) Lin Lout :-
-    try_answer_type_list L G Lin Lout.
-  try_answer_type X Y Lin Lout :-
-    var X, ground_term Y, replace_var_in_list X Y Lin Lout.
-  try_answer_type X Y L L :-
+  pred try_answer_type i:ty o:ty i:ty o:ty i:list assertion o:list assertion.
+  try_answer_type X Y IX IY Lin Lout :-
+    var X, var Y,
+    replace_var_term X Y IX IY,
+    replace_var_in_list X Y Lin Lout.
+  try_answer_type (app L) (app G) IX IY Lin Lout :-
+    try_answer_type_list L G IX IY Lin Lout.
+  try_answer_type X Y IX IY Lin Lout :-
+    var X, ground_term Y, replace_var_term X Y IX IY, replace_var_in_list X Y Lin Lout.
+  try_answer_type X Y I I L L :-
     ground_term X,
     ground_term Y,
     cmp_term X Y eq.
 
-  pred try_answer_type_list i:list ty o:list ty i:list assertion o:list assertion.
-  try_answer_type_list [ X | XS ] [ Y | YS ] Lin Lout :-
-      try_answer_type X Y Lin Ltemp,
-      try_answer_type_list XS YS Ltemp Lout.
-  try_answer_type_list [] [] L L.
+  pred try_answer_type_list i:list ty o:list ty i:ty o:ty i:list assertion o:list assertion.
+  try_answer_type_list [ X | XS ] [ Y | YS ] IX IY Lin Lout :-
+      try_answer_type X Y IX Itemp Lin Ltemp,
+      try_answer_type_list XS YS Itemp IY Ltemp Lout.
+  try_answer_type_list [] [] I I L L.
 
-  pred try_answer i:assertion o:assertion i:list assertion o:list assertion.
-  try_answer (assertion A _) (assertion B _) Lin Lout :-
+  pred try_answer i:assertion o:assertion i:assertion o:assertion i:list assertion o:list assertion.
+  try_answer (assertion A VA) (assertion B VB) (assertion G IA) (assertion G IB) Lin Lout :-
     coq.say "Try answer",
-    coq.say "A" A,
-    coq.say "B" B,
-    try_answer_type A B Lin Lout.
+    coq.say "A" A VA,
+    coq.say "B" B VB,
+    try_answer_type A B IA ITemp Lin Lout,
+    replace_var_term VA VB ITemp IB,
+    coq.say "IAB" IA IB,
+    coq.sigma.print.
 }}.
 
 Elpi Accumulate lp:{{
@@ -225,13 +228,13 @@ Elpi Accumulate lp:{{
     ground_term X,
     X = Y.
 
-  pred try_resolve_types i:term i:term o:list term o:list term.
+  pred try_resolve_types i:term i:term o:list term o:list assertion.
   try_resolve_types A (prod X T F) OL L :-
     !,
     coq.typecheck V T ok,
     try_resolve_types A (F V) OLS LS,
     (OL = [ V | OLS]),
-    ((ground_term T, L = LS) ; L = [ T | LS ])
+    ((ground_term T, L = LS) ; L = [ assertion T V | LS ])
     .
   try_resolve_types A B [] [] :-
     /* @holes! ==> coq.unify-leq B A ok */
@@ -253,10 +256,10 @@ Elpi Accumulate lp:{{
   simpl (app [ A ]) A.
   simpl A A.
 
-  pred filter_metavariables i:list term o:list term.
-  filter_metavariables [ (app L) | XS ] [ app L | YS ] :-
+  pred filter_metavariables i:list assertion o:list assertion.
+  filter_metavariables [ assertion (app L) V | XS ] [ assertion (app L) V | YS ] :-
       !, filter_metavariables XS YS.
-  filter_metavariables [ X | XS ] YS :-
+  filter_metavariables [ assertion X _ | XS ] YS :-
       filter_metavariables XS YS.
   filter_metavariables [] [].
 
@@ -273,9 +276,8 @@ Elpi Accumulate lp:{{
     /* coq.say "regeneralize" OL L, */
     /* re_generalize L LR, */
     /* coq.say "generalized" LR, */
-    filter_metavariables L LR,
+    filter_metavariables L RL,
     !,
-    (std.map LR helper_fn RL),
     coq.say "RL" RL,
     RT = A, /* app [ B | OL ], */
     ((OL = [], RV = BITm) ; RV = app [ BITm | OL ]),
@@ -288,12 +290,16 @@ Elpi Accumulate lp:{{
 
 Elpi Accumulate lp:{{
   pred temp_fun i:consumer_node i:assertion o:(pair consumer_node assertion).
-  temp_fun A B (pr A B).
+  temp_fun A B (pr A B) :-
+    coq.say "Update - Try" A "with answer" B.
 
   pred waiter_fun i:assertion i:assertion i:waiter i:(pair (resume_stack) (option assertion)) o:(pair (resume_stack) (option assertion)).
-  waiter_fun Answer _ root (pr A _) (pr A (some Answer)) :-
-    coq.say "Found answer" Answer.
-waiter_fun Answer _ (callback C) (pr A R) (pr [pr C Answer /* Goal */ | A] R) :- coq.say "Run Waiter".
+  waiter_fun Answer Guess root (pr A _) (pr A (some Answer)) :-
+    coq.say "Found root answer" Answer,
+    coq.say "Stack" A Guess.
+  waiter_fun Answer Goal (callback C) (pr A R) (pr [pr C Answer /* Goal */ | A] R) :-
+      coq.say "Found an answer" C Goal Answer,
+      coq.say "Run Waiter".
 
   pred new_consumer_node i:synth i:assertion i:consumer_node o:synth.
   new_consumer_node
@@ -306,10 +312,12 @@ waiter_fun Answer _ (callback C) (pr A R) (pr [pr C Answer /* Goal */ | A] R) :-
     /* add new cnode to g's dependents */
     /* TODO: Add answer here! */
     NewAnswers = [ Answer | Answers ],
+    coq.say "NewAnswers" NewAnswers,
     /* for each solution to g, push new cnode onto resume stack with it */
     std.fold Waiters (pr ResumeStack RootAnswer) (waiter_fun Answer Goal) (pr NewResumeStack NewRootAnswer),
     /* add new cnode to g's dependents */
-    std.map.add Goal (entry Waiters NewAnswers) AssertionTable NewAssertionTable /* TODO: [] or Waiters? */.
+    std.map.remove Goal AssertionTable TempAssertionTable,
+    std.map.add Goal (entry Waiters NewAnswers) TempAssertionTable NewAssertionTable /* TODO: [] or Waiters? */.
 
   new_consumer_node
       (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
@@ -320,11 +328,15 @@ waiter_fun Answer _ (callback C) (pr A R) (pr [pr C Answer /* Goal */ | A] R) :-
       /* TODO: Consumer node is general instead of variable or hole */
       if (std.map.find Subgoal AssertionTable (entry Waiters Answers))
          (
+          /* Map answers with consumer node */
+          coq.say "Found subgoal map" Answers,
+          /* Add cnode onto G's dependents? */
           std.map Answers (temp_fun CN) TempResumeStack,
           std.append TempResumeStack ResumeStack NewResumeStack,
 
           NewWaiters = [ callback CN | Waiters ],
-          std.map.add Subgoal (entry NewWaiters Answers) AssertionTable NewAssertionTable,
+          std.map.remove Subgoal AssertionTable TempAssertionTable,
+          std.map.add Subgoal (entry NewWaiters Answers) TempAssertionTable NewAssertionTable,
           NewGeneratorStack = GeneratorStack
          )
          (
@@ -345,20 +357,21 @@ Elpi Accumulate lp:{{
   tabled_typeclass_resolution_body
     (synth GeneratorStack [ (pr (consumer_node Goal [ Subgoal | Remaining ]) Answer) | ResumeStack ]
        AssertionTable RootAnswer) Query MySynth FinalAnswer :-
-    coq.say "ResumeStack" Subgoal Answer,
+    coq.say "ResumeStack" Goal Subgoal Answer,
     Answer = assertion AnswerT AnswerV,
     coq.typecheck AnswerV AnswerNT ok,
     NewAnswer = assertion AnswerNT AnswerV,
     (ground_term Answer; coq.say "Not ground answer"), /* TODO: Should answer be ground? */
-    if (try_answer Subgoal NewAnswer Remaining UpdatedRemaining)
-       (coq.say "Suceed try" Remaining,
+    if (try_answer Subgoal NewAnswer Goal UpdatedGoal Remaining UpdatedRemaining)
+       (coq.say "Suceed try" Remaining UpdatedRemaining,
        /* TODO: Update Remaining with unification from try_answer ! */
        /* keep goal? clone? */
-        coq.say "Actual" Subgoal,
+        coq.say "Actual" Subgoal NewAnswer,
+        coq.say "Goal" Goal UpdatedGoal,
         new_consumer_node
          (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-         NewAnswer
-         (consumer_node Goal UpdatedRemaining) /* TODO: Was Goal in code, but should add new solution? */
+         UpdatedGoal /* TODO: final answer here! */
+         (consumer_node UpdatedGoal UpdatedRemaining) /* TODO: Was Goal in code, but should add new solution? */
          MySynth
       )
       (
@@ -378,12 +391,12 @@ Elpi Accumulate lp:{{
     if (try_resolve Goal Instance Resolved Subgoals)
         (
         /* else (l. 14) */
-        coq.say "Resolved" Resolved "Subgoals" Subgoals,
+        coq.say "Resolved" Goal Resolved "Subgoals" Subgoals,
         (ground_term Resolved ; coq.say "Resolved not ground"),
         (new_consumer_node
           (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
           Resolved /* TODO: does not follow protocol! dummy value? */
-          (consumer_node Goal Subgoals) NewSynth), /* TODO: Should not be goal but answer? */
+          (consumer_node Resolved Subgoals) NewSynth), /* TODO: Should not be goal but answer? */
         coq.say "No fall trhough"
         )
         (
@@ -440,33 +453,22 @@ Elpi Query lp:{{
   coq.typecheck FinalAnswer MyGoal ok.
 }}.
 
+(* Instance TestRAB : R1 A1 B1 := _. *)
+
 (* Example from Paper *)
 Elpi Query lp:{{
   MyGoal = {{ R1 A1 D1 }},
   coq.say "MyGoal" (assertion MyGoal {{ lib:elpi.hole }}),
   tabled_typeclass_resolution (assertion MyGoal {{ lib:elpi.hole }}) (assertion FinalType FinalAnswer),
   !,
-  coq.say "FinalAnswer" FinalType FinalAnswer "vs" {{ @I4 A1 D1 C1 I2 I3 }} {{ I4 _ _ }},
-  FinalAnswer = MyGoal,
+  coq.say "FinalAnswer" FinalType FinalAnswer "vs" {{ @I4 A1 C1 D1 I2 I3 }} {{ I4 I2 I3 }},
+  FinalType = MyGoal,
+  coq.say "Typechecks?",
   coq.typecheck FinalAnswer MyGoal ok,
-  /* TODO: Currently fails here, recreation of terms is incorrect */
+  coq.say "Final Ground?",
   ground_term FinalAnswer.
 }}.
 
-(* Example that should fail *)
-Axiom E : Type.
-(*,
-Elpi Query lp:{{
-  MyGoal = assertion {{ R A E }},
-  (tabled_typeclass_resolution MyGoal FinalAnswer),
-  coq.say "Finished" FinalAnswer.
-  not (tabled_typeclass_resolution MyGoal FinalAnswer),
-  coq.say "Finished" FinalAnswer.
-}}.
- *)
-
-(* https://github.com/leanprover/lean4/blob/cade21/src/Lean/Meta/SynthInstance.lean *)
-(* https://github.com/leanprover/lean4/blob/master/tests/lean/run/typeclass_diamond.lean *)
 (* https://github.com/LPCIC/coq-elpi/blob/master/builtin-doc/coq-builtin.elpi *)
 Elpi Accumulate lp:{{
   pred proof_search i:list gref i:list tc-instance i:term o:term.
@@ -527,6 +529,7 @@ Elpi Accumulate lp:{{
     (search_context Ctx Type PRoof ; tabled_proof_search Typeclasses Type PRoof),
     coq.say "SUCCESS FINDING INSTANCE".
 
+
   solve _ _ :- coq.ltac.fail _ "No auto".
 }}.
 
@@ -546,3 +549,31 @@ Elpi Query lp:{{
   coq.say "Elaborates to" V.
 }}.
 Instance TestConstant : Constant := _.
+
+(* Test instance dependency *)
+Class Dependency := {}.
+
+Instance Dep `{Constant} : Dependency := {}.
+
+Elpi Query lp:{{
+  /* {{ Instance TestConstant : Constant := _ }} */
+  coq.elaborate-skeleton {{ lib:elpi.hole }} {{ Constant }} V ok,
+  coq.say "Elaborates to" V.
+}}.
+
+Elpi Query lp:{{
+  coq.say "Dep" {{ Constant }},
+  coq.elaborate-skeleton {{ lib:elpi.hole }} {{ Constant }} _ ok, !,
+  coq.elaborate-skeleton {{ lib:elpi.hole }} {{ Dependency }} V ok,
+  coq.say "Elaborates to" V.
+}}.
+
+Instance TestDependency : Dependency := _.
+
+(* Trivial test *)
+Class Argument (alpha : Type) := {}.
+Instance Arg : Argument unit := {}.
+Instance TestArgument : Argument unit := _.
+
+Instance AArg (alpha : Type) : Argument alpha := {}.
+(* Instance TestArgumentArg : Argument nat := _. *)

From 470395b78723f46eda751e83004723a70dbb86ac Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Sun, 10 Aug 2025 22:30:48 +0200
Subject: [PATCH 04/23] Cleanup a bit

---
 apps/tc-tabled/theories/tabled_type_class.v | 69 +++------------------
 1 file changed, 10 insertions(+), 59 deletions(-)

diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index 5c8ffd1d6..aa997bbc0 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -70,7 +70,6 @@ Elpi Accumulate lp:{{
 
   pred assertion_equal i:assertion i:assertion o:cmp.
   assertion_equal (assertion A _) (assertion B _) Cmp :-
-  /* coq.say "Assertions equal?" A B, */
     type_equal A B Cmp.
 
   pred term_typeclass i:term o:gref.
@@ -90,12 +89,9 @@ Elpi Accumulate lp:{{
     (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
     Subgoal Waiter
     (synth NewGeneratorStack ResumeStack NewAssertionTable RootAnswer) :-
-    coq.say "Enter" Subgoal Waiter,
     std.map.add Subgoal (entry [Waiter] []) AssertionTable NewAssertionTable,
-    coq.say "AssertionTable" NewAssertionTable,
     assertion_typeclass Subgoal Name,
     coq.TC.db-for Name Instances,
-    /* coq.say "New Subgoal" Name Instances, */
     NewGeneratorStack = [(generator_node Subgoal Instances) | GeneratorStack]
     .
 }}.
@@ -141,13 +137,8 @@ Elpi Accumulate lp:{{
 
   pred try_answer i:assertion o:assertion i:assertion o:assertion i:list assertion o:list assertion.
   try_answer (assertion A VA) (assertion B VB) (assertion G IA) (assertion G IB) Lin Lout :-
-    coq.say "Try answer",
-    coq.say "A" A VA,
-    coq.say "B" B VB,
     try_answer_type A B IA ITemp Lin Lout,
-    replace_var_term VA VB ITemp IB,
-    coq.say "IAB" IA IB,
-    coq.sigma.print.
+    replace_var_term VA VB ITemp IB.
 }}.
 
 Elpi Accumulate lp:{{
@@ -199,8 +190,7 @@ Elpi Accumulate lp:{{
        std.length Tlist Len,
        Index is Len - 1,
        extract_variables Tlist Index NewR,
-       R = [ NewR | RTl ],
-       coq.say "NewR" NewR
+       R = [ NewR | RTl ]
        );
       (R = RTl)
     ),
@@ -271,35 +261,21 @@ Elpi Accumulate lp:{{
     coq.gref->string BI BIName,
     BI = const (BIConst),
     coq.env.const BIConst (some BIBody) BITy,
-    coq.say "Try resolve types" A B,
     try_resolve_types A B OL L,
-    /* coq.say "regeneralize" OL L, */
-    /* re_generalize L LR, */
-    /* coq.say "generalized" LR, */
     filter_metavariables L RL,
     !,
-    coq.say "RL" RL,
     RT = A, /* app [ B | OL ], */
-    ((OL = [], RV = BITm) ; RV = app [ BITm | OL ]),
-    coq.say "Result" RT RV "for" A
-
-    /* ATm = app [ B | OL ],
-        simpl ATm ATmRed */
+    ((OL = [], RV = BITm) ; RV = app [ BITm | OL ])
     .
 }}.
 
 Elpi Accumulate lp:{{
   pred temp_fun i:consumer_node i:assertion o:(pair consumer_node assertion).
-  temp_fun A B (pr A B) :-
-    coq.say "Update - Try" A "with answer" B.
+  temp_fun A B (pr A B).
 
   pred waiter_fun i:assertion i:assertion i:waiter i:(pair (resume_stack) (option assertion)) o:(pair (resume_stack) (option assertion)).
-  waiter_fun Answer Guess root (pr A _) (pr A (some Answer)) :-
-    coq.say "Found root answer" Answer,
-    coq.say "Stack" A Guess.
-  waiter_fun Answer Goal (callback C) (pr A R) (pr [pr C Answer /* Goal */ | A] R) :-
-      coq.say "Found an answer" C Goal Answer,
-      coq.say "Run Waiter".
+  waiter_fun Answer Guess root (pr A _) (pr A (some Answer)).
+  waiter_fun Answer Goal (callback C) (pr A R) (pr [pr C Answer /* Goal */ | A] R).
 
   pred new_consumer_node i:synth i:assertion i:consumer_node o:synth.
   new_consumer_node
@@ -312,7 +288,6 @@ Elpi Accumulate lp:{{
     /* add new cnode to g's dependents */
     /* TODO: Add answer here! */
     NewAnswers = [ Answer | Answers ],
-    coq.say "NewAnswers" NewAnswers,
     /* for each solution to g, push new cnode onto resume stack with it */
     std.fold Waiters (pr ResumeStack RootAnswer) (waiter_fun Answer Goal) (pr NewResumeStack NewRootAnswer),
     /* add new cnode to g's dependents */
@@ -329,7 +304,6 @@ Elpi Accumulate lp:{{
       if (std.map.find Subgoal AssertionTable (entry Waiters Answers))
          (
           /* Map answers with consumer node */
-          coq.say "Found subgoal map" Answers,
           /* Add cnode onto G's dependents? */
           std.map Answers (temp_fun CN) TempResumeStack,
           std.append TempResumeStack ResumeStack NewResumeStack,
@@ -357,17 +331,13 @@ Elpi Accumulate lp:{{
   tabled_typeclass_resolution_body
     (synth GeneratorStack [ (pr (consumer_node Goal [ Subgoal | Remaining ]) Answer) | ResumeStack ]
        AssertionTable RootAnswer) Query MySynth FinalAnswer :-
-    coq.say "ResumeStack" Goal Subgoal Answer,
     Answer = assertion AnswerT AnswerV,
     coq.typecheck AnswerV AnswerNT ok,
     NewAnswer = assertion AnswerNT AnswerV,
-    (ground_term Answer; coq.say "Not ground answer"), /* TODO: Should answer be ground? */
     if (try_answer Subgoal NewAnswer Goal UpdatedGoal Remaining UpdatedRemaining)
-       (coq.say "Suceed try" Remaining UpdatedRemaining,
+       (
        /* TODO: Update Remaining with unification from try_answer ! */
        /* keep goal? clone? */
-        coq.say "Actual" Subgoal NewAnswer,
-        coq.say "Goal" Goal UpdatedGoal,
         new_consumer_node
          (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
          UpdatedGoal /* TODO: final answer here! */
@@ -375,14 +345,13 @@ Elpi Accumulate lp:{{
          MySynth
       )
       (
-        coq.say "Continues",
         MySynth = (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
       ).
 
   tabled_typeclass_resolution_body
     (synth GeneratorStack [ (pr (consumer_node Goal []) Answer) | ResumeStack ]
        AssertionTable RootAnswer) Query MySynth FinalAnswer :-
-   coq.say "Cannot resume with empty subgoals!",
+   coq.warn "Cannot resume with empty subgoals!",
    fail.
 
   tabled_typeclass_resolution_body
@@ -391,17 +360,13 @@ Elpi Accumulate lp:{{
     if (try_resolve Goal Instance Resolved Subgoals)
         (
         /* else (l. 14) */
-        coq.say "Resolved" Goal Resolved "Subgoals" Subgoals,
-        (ground_term Resolved ; coq.say "Resolved not ground"),
         (new_consumer_node
           (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
           Resolved /* TODO: does not follow protocol! dummy value? */
-          (consumer_node Resolved Subgoals) NewSynth), /* TODO: Should not be goal but answer? */
-        coq.say "No fall trhough"
+          (consumer_node Resolved Subgoals) NewSynth)
         )
         (
         /* If first subgoal of cnode does not resolve with solution then Continue */
-        coq.say "Fall through",
         NewSynth = (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
       ).
 
@@ -429,7 +394,6 @@ Elpi Accumulate lp:{{
 
   pred tabled_typeclass_resolution i:assertion o:assertion.
   tabled_typeclass_resolution Query FinalAnswer :-
-    coq.say "Query?" Query,
     std.map.make assertion_equal AssertionTableEmpty,
     new_subgoal (synth [] [] AssertionTableEmpty none) Query root MySynth,
     /* while true do */
@@ -489,29 +453,16 @@ Elpi Accumulate lp:{{
 Elpi Accumulate lp:{{
   pred tabled_proof_search i:list gref i:term o:term.
   tabled_proof_search Typeclasses Type PRoof :-
-    coq.say "TYPECLASSES" Typeclasses,
-    coq.say "TYPE" Type,
-    /*
-    std.map.make cmp_term ClassInstancesTemp,
-    std.fold Typeclasses ClassInstancesTemp fold_class_instances ClassInstances,
-    */
     MyGoal = assertion Type {{ _ }},
     /* term_to_assertion Type none MyGoal, /* MyGoal is Assertion */ */
-    coq.say "Goal" MyGoal,
-    coq.say "Attemp" MyGoal ClassInstances,
     tabled_typeclass_resolution MyGoal FinalAnswer,
     !,
     coq.say "Final Answer" FinalAnswer,
-
-    /* TODO: Convert from result to proof term! */
-
     FinalAnswer = assertion FinalType FinalTerm,
     FinalProof = FinalTerm,
     coq.say "FinalProof" FinalProof,
     PRoof = FinalProof,
-    coq.say "Proof" PRoof,
-
-    coq.say "Done".
+    coq.say "Proof" PRoof "Done".
 
 
   pred search_context i:list prop i:term o:term.

From c0b7732cfb71b6b79c9c43876eec6e4eb9ab2b90 Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Sun, 10 Aug 2025 22:31:14 +0200
Subject: [PATCH 05/23] comment out failing part

---
 apps/tc-tabled/theories/tabled_type_class.v | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index aa997bbc0..ac07f4eb4 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -519,12 +519,12 @@ Elpi Query lp:{{
   coq.say "Elaborates to" V.
 }}.
 
-Instance TestDependency : Dependency := _.
+(* Instance TestDependency : Dependency := _. *)
 
-(* Trivial test *)
-Class Argument (alpha : Type) := {}.
-Instance Arg : Argument unit := {}.
-Instance TestArgument : Argument unit := _.
+(* (* Trivial test *) *)
+(* Class Argument (alpha : Type) := {}. *)
+(* Instance Arg : Argument unit := {}. *)
+(* Instance TestArgument : Argument unit := _. *)
 
-Instance AArg (alpha : Type) : Argument alpha := {}.
+(* Instance AArg (alpha : Type) : Argument alpha := {}. *)
 (* Instance TestArgumentArg : Argument nat := _. *)

From 54beefebbf36a4299b80b41cd5e11286544bf7ef Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Sun, 10 Aug 2025 23:16:00 +0200
Subject: [PATCH 06/23] Working diamond example with Tabled Typeclass in Elpi

---
 apps/tc-tabled/theories/tabled_type_class.v | 157 ++++++++++++++++++--
 1 file changed, 147 insertions(+), 10 deletions(-)

diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index ac07f4eb4..f82331085 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -220,15 +220,19 @@ Elpi Accumulate lp:{{
 
   pred try_resolve_types i:term i:term o:list term o:list assertion.
   try_resolve_types A (prod X T F) OL L :-
+    coq.say "Test" A X T,
     !,
     coq.typecheck V T ok,
+    coq.say "Passed",
     try_resolve_types A (F V) OLS LS,
     (OL = [ V | OLS]),
-    ((ground_term T, L = LS) ; L = [ assertion T V | LS ])
+    ((T = app _ ; L = [ assertion T V | LS ]) ; (L = LS)) /* TODO : better 'contains instance or var test' */
     .
   try_resolve_types A B [] [] :-
     /* @holes! ==> coq.unify-leq B A ok */
-    does_type_resolve A B
+    coq.say "Does type resolve" A B,
+    does_type_resolve A B,
+    coq.say "Yes"
     /* type_equal A B lt */
     /* cmp_term A B eq */
     /* @holes! ==> pattern_match A B */
@@ -385,7 +389,7 @@ Elpi Accumulate lp:{{
   synth_loop (synth _ _ _ (some Answer)) _ Fuel Answer.
   synth_loop MySynth Query Fuel FinalAnswer :-
     MySynth = synth Stack1 Stack2 _ _,
-    coq.say Fuel Stack2 Stack1,
+    coq.say "synth round" Fuel Stack2 Stack1,
     Fuel > 0,
     tabled_typeclass_resolution_body MySynth Query NextSynth FinalAnswer,
     !,
@@ -521,10 +525,143 @@ Elpi Query lp:{{
 
 (* Instance TestDependency : Dependency := _. *)
 
-(* (* Trivial test *) *)
-(* Class Argument (alpha : Type) := {}. *)
-(* Instance Arg : Argument unit := {}. *)
-(* Instance TestArgument : Argument unit := _. *)
-
-(* Instance AArg (alpha : Type) : Argument alpha := {}. *)
-(* Instance TestArgumentArg : Argument nat := _. *)
+(* Trivial test *)
+Class Argument (alpha : Type) := {}.
+Instance Arg : Argument unit := {}.
+Instance TestArgument : Argument unit := _.
+
+Instance AArg (alpha : Type) : Argument alpha := {}.
+Instance TestArgumentArg : Argument nat := _.
+
+(* Direct Simple Diamond example *)
+Class TD (n : nat).
+Class RD (n : nat).
+Class LD (n : nat).
+Class BD (n : nat).
+
+Instance BD0 : BD 0 := {}.
+
+Instance BtL0 `{BD 0} : LD 0 := {}.
+Instance BtR0 `{BD 0} : RD 0 := {}.
+Instance LtR0 `{LD 0} : TD 0 := {}.
+Instance RtR0 `{RD 0} : TD 0 := {}.
+Instance Ttb0 `{TD 0} : BD (S 0) := {}.
+
+Instance BtL1 `{BD 1} : LD 1 := {}.
+Instance BtR1 `{BD 1} : RD 1 := {}.
+Instance LtR1 `{LD 1} : TD 1 := {}.
+Instance RtR1 `{RD 1} : TD 1 := {}.
+Instance Ttb1 `{TD 1} : BD (S 1) := {}.
+
+Instance BtL2 `{BD 2} : LD 2 := {}.
+Instance BtR2 `{BD 2} : RD 2 := {}.
+Instance LtR2 `{LD 2} : TD 2 := {}.
+Instance RtR2 `{RD 2} : TD 2 := {}.
+Instance Ttb2 `{TD 2} : BD (S 2) := {}.
+
+Instance BtL3 `{BD 3} : LD 3 := {}.
+Instance BtR3 `{BD 3} : RD 3 := {}.
+Instance LtR3 `{LD 3} : TD 3 := {}.
+Instance RtR3 `{RD 3} : TD 3 := {}.
+Instance Ttb3 `{TD 3} : BD (S 3) := {}.
+
+Instance BtL4 `{BD 4} : LD 4 := {}.
+Instance BtR4 `{BD 4} : RD 4 := {}.
+Instance LtR4 `{LD 4} : TD 4 := {}.
+Instance RtR4 `{RD 4} : TD 4 := {}.
+Instance Ttb4 `{TD 4} : BD (S 4) := {}.
+
+Instance BtL5 `{BD 5} : LD 5 := {}.
+Instance BtR5 `{BD 5} : RD 5 := {}.
+Instance LtR5 `{LD 5} : TD 5 := {}.
+Instance RtR5 `{RD 5} : TD 5 := {}.
+Instance Ttb5 `{TD 5} : BD (S 5) := {}.
+
+Instance BtL6 `{BD 6} : LD 6 := {}.
+Instance BtR6 `{BD 6} : RD 6 := {}.
+Instance LtR6 `{LD 6} : TD 6 := {}.
+Instance RtR6 `{RD 6} : TD 6 := {}.
+Instance Ttb6 `{TD 6} : BD (S 6) := {}.
+
+Instance BtL7 `{BD 7} : LD 7 := {}.
+Instance BtR7 `{BD 7} : RD 7 := {}.
+Instance LtR7 `{LD 7} : TD 7 := {}.
+Instance RtR7 `{RD 7} : TD 7 := {}.
+Instance Ttb7 `{TD 7} : BD (S 7) := {}.
+
+Instance BtL8 `{BD 8} : LD 8 := {}.
+Instance BtR8 `{BD 8} : RD 8 := {}.
+Instance LtR8 `{LD 8} : TD 8 := {}.
+Instance RtR8 `{RD 8} : TD 8 := {}.
+Instance Ttb8 `{TD 8} : BD (S 8) := {}.
+
+Instance BtL9 `{BD 9} : LD 9 := {}.
+Instance BtR9 `{BD 9} : RD 9 := {}.
+Instance LtR9 `{LD 9} : TD 9 := {}.
+Instance RtR9 `{RD 9} : TD 9 := {}.
+Instance Ttb9 `{TD 9} : BD (S 9) := {}.
+
+Instance BtL10 `{BD 10} : LD 10 := {}.
+Instance BtR10 `{BD 10} : RD 10 := {}.
+Instance LtR10 `{LD 10} : TD 10 := {}.
+Instance RtR10 `{RD 10} : TD 10 := {}.
+Instance Ttb10 `{TD 10} : BD (S 10) := {}.
+
+Instance BtL11 `{BD 11} : LD 11 := {}.
+Instance BtR11 `{BD 11} : RD 11 := {}.
+Instance LtR11 `{LD 11} : TD 11 := {}.
+Instance RtR11 `{RD 11} : TD 11 := {}.
+Instance Ttb11 `{TD 11} : BD (S 11) := {}.
+
+Instance TestTD10 : TD 11 := _.
+
+(* Partial Simple Diamond example *)
+Class T (n : nat).
+Class R (n : nat).
+Class L (n : nat).
+Class B (n : nat).
+Instance BtL n `{B n} : L n := {}.
+Instance BtR n `{B n} : R n := {}.
+Instance LtR n `{L n} : T n := {}.
+Instance RtR n `{R n} : T n := {}.
+Instance Ttb n `{T n} : B (S n) := {}.
+
+Instance B0 : B 0 := {}.
+
+Instance Test0 : B 0 := _.
+Instance Test1 : B 1 := _.
+Instance Test2 : B 2 := _.
+
+Instance Test10 : B 10 := _.
+
+Instance Test4 : B 4 := _.
+Instance Test100 : B 10 := _.
+
+(* Partial Diamond example *)
+Class T (alpha : Type) (n : nat).
+Class R (alpha : Type) (n : nat).
+Class L (alpha : Type) (n : nat).
+Class B (alpha : Type) (n : nat).
+Instance BtL alpha n `{B alpha n} : L alpha n := {}.
+Instance BtR alpha n `{B alpha n} : R alpha n := {}.
+Instance LtR alpha n `{L alpha n} : T alpha n := {}.
+Instance RtR alpha n `{R alpha n} : T alpha n := {}.
+
+Instance B0 alpha : B alpha 0 := {}.
+
+Instance Test0 : B unit 0 := _.
+
+(* Diamond example in Rocq *)
+Class T (alpha : Type) (n : nat).
+Class R (alpha : Type) (n : nat).
+Class L (alpha : Type) (n : nat).
+Class B (alpha : Type) (n : nat).
+Instance BtL alpha n `{B alpha n} : L alpha n := {}.
+Instance BtR alpha n `{B alpha n} : R alpha n := {}.
+Instance LtR alpha n `{L alpha n} : T alpha n := {}.
+Instance RtR alpha n `{R alpha n} : T alpha n := {}.
+Instance TtR alpha n `{T alpha n} : B alpha (S n) := {}.
+
+Instance B0 alpha : B alpha 0 := {}.
+
+Fail Instance TtR20 : B unit 20 := _.

From fe4f101371c790abd438a0a822c98d8d0c8dd0ab Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Sun, 10 Aug 2025 23:30:06 +0200
Subject: [PATCH 07/23] working (unfolded) diamond example using Elpi tabled
 type class in Rocq

---
 apps/tc-tabled/theories/tabled_type_class.v | 107 ++++++++++----------
 1 file changed, 51 insertions(+), 56 deletions(-)

diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index f82331085..b3fa5a30a 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -220,19 +220,15 @@ Elpi Accumulate lp:{{
 
   pred try_resolve_types i:term i:term o:list term o:list assertion.
   try_resolve_types A (prod X T F) OL L :-
-    coq.say "Test" A X T,
     !,
     coq.typecheck V T ok,
-    coq.say "Passed",
     try_resolve_types A (F V) OLS LS,
     (OL = [ V | OLS]),
     ((T = app _ ; L = [ assertion T V | LS ]) ; (L = LS)) /* TODO : better 'contains instance or var test' */
     .
   try_resolve_types A B [] [] :-
     /* @holes! ==> coq.unify-leq B A ok */
-    coq.say "Does type resolve" A B,
-    does_type_resolve A B,
-    coq.say "Yes"
+    does_type_resolve A B
     /* type_equal A B lt */
     /* cmp_term A B eq */
     /* @holes! ==> pattern_match A B */
@@ -461,7 +457,6 @@ Elpi Accumulate lp:{{
     /* term_to_assertion Type none MyGoal, /* MyGoal is Assertion */ */
     tabled_typeclass_resolution MyGoal FinalAnswer,
     !,
-    coq.say "Final Answer" FinalAnswer,
     FinalAnswer = assertion FinalType FinalTerm,
     FinalProof = FinalTerm,
     coq.say "FinalProof" FinalProof,
@@ -615,53 +610,53 @@ Instance Ttb11 `{TD 11} : BD (S 11) := {}.
 
 Instance TestTD10 : TD 11 := _.
 
-(* Partial Simple Diamond example *)
-Class T (n : nat).
-Class R (n : nat).
-Class L (n : nat).
-Class B (n : nat).
-Instance BtL n `{B n} : L n := {}.
-Instance BtR n `{B n} : R n := {}.
-Instance LtR n `{L n} : T n := {}.
-Instance RtR n `{R n} : T n := {}.
-Instance Ttb n `{T n} : B (S n) := {}.
-
-Instance B0 : B 0 := {}.
-
-Instance Test0 : B 0 := _.
-Instance Test1 : B 1 := _.
-Instance Test2 : B 2 := _.
-
-Instance Test10 : B 10 := _.
-
-Instance Test4 : B 4 := _.
-Instance Test100 : B 10 := _.
-
-(* Partial Diamond example *)
-Class T (alpha : Type) (n : nat).
-Class R (alpha : Type) (n : nat).
-Class L (alpha : Type) (n : nat).
-Class B (alpha : Type) (n : nat).
-Instance BtL alpha n `{B alpha n} : L alpha n := {}.
-Instance BtR alpha n `{B alpha n} : R alpha n := {}.
-Instance LtR alpha n `{L alpha n} : T alpha n := {}.
-Instance RtR alpha n `{R alpha n} : T alpha n := {}.
-
-Instance B0 alpha : B alpha 0 := {}.
-
-Instance Test0 : B unit 0 := _.
-
-(* Diamond example in Rocq *)
-Class T (alpha : Type) (n : nat).
-Class R (alpha : Type) (n : nat).
-Class L (alpha : Type) (n : nat).
-Class B (alpha : Type) (n : nat).
-Instance BtL alpha n `{B alpha n} : L alpha n := {}.
-Instance BtR alpha n `{B alpha n} : R alpha n := {}.
-Instance LtR alpha n `{L alpha n} : T alpha n := {}.
-Instance RtR alpha n `{R alpha n} : T alpha n := {}.
-Instance TtR alpha n `{T alpha n} : B alpha (S n) := {}.
-
-Instance B0 alpha : B alpha 0 := {}.
-
-Fail Instance TtR20 : B unit 20 := _.
+(* (* Partial Simple Diamond example *) *)
+(* Class T (n : nat). *)
+(* Class R (n : nat). *)
+(* Class L (n : nat). *)
+(* Class B (n : nat). *)
+(* Instance BtL n `{B n} : L n := {}. *)
+(* Instance BtR n `{B n} : R n := {}. *)
+(* Instance LtR n `{L n} : T n := {}. *)
+(* Instance RtR n `{R n} : T n := {}. *)
+(* Instance Ttb n `{T n} : B (S n) := {}. *)
+
+(* Instance B0 : B 0 := {}. *)
+
+(* Instance Test0 : B 0 := _. *)
+(* Instance Test1 : B 1 := _. *)
+(* Instance Test2 : B 2 := _. *)
+
+(* Instance Test10 : B 10 := _. *)
+
+(* Instance Test4 : B 4 := _. *)
+(* Instance Test100 : B 10 := _. *)
+
+(* (* Partial Diamond example *) *)
+(* Class T (alpha : Type) (n : nat). *)
+(* Class R (alpha : Type) (n : nat). *)
+(* Class L (alpha : Type) (n : nat). *)
+(* Class B (alpha : Type) (n : nat). *)
+(* Instance BtL alpha n `{B alpha n} : L alpha n := {}. *)
+(* Instance BtR alpha n `{B alpha n} : R alpha n := {}. *)
+(* Instance LtR alpha n `{L alpha n} : T alpha n := {}. *)
+(* Instance RtR alpha n `{R alpha n} : T alpha n := {}. *)
+
+(* Instance B0 alpha : B alpha 0 := {}. *)
+
+(* Instance Test0 : B unit 0 := _. *)
+
+(* (* Diamond example in Rocq *) *)
+(* Class T (alpha : Type) (n : nat). *)
+(* Class R (alpha : Type) (n : nat). *)
+(* Class L (alpha : Type) (n : nat). *)
+(* Class B (alpha : Type) (n : nat). *)
+(* Instance BtL alpha n `{B alpha n} : L alpha n := {}. *)
+(* Instance BtR alpha n `{B alpha n} : R alpha n := {}. *)
+(* Instance LtR alpha n `{L alpha n} : T alpha n := {}. *)
+(* Instance RtR alpha n `{R alpha n} : T alpha n := {}. *)
+(* Instance TtR alpha n `{T alpha n} : B alpha (S n) := {}. *)
+
+(* Instance B0 alpha : B alpha 0 := {}. *)
+
+(* Fail Instance TtR20 : B unit 20 := _. *)

From 5a323826f575227752c4d325997fe55b6f7358a0 Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Sun, 10 Aug 2025 23:48:52 +0200
Subject: [PATCH 08/23] Prepare diamond unfold test

---
 apps/tc-tabled/theories/diamond_unfolded.v | 1211 ++++++++++++++++++++
 1 file changed, 1211 insertions(+)
 create mode 100644 apps/tc-tabled/theories/diamond_unfolded.v

diff --git a/apps/tc-tabled/theories/diamond_unfolded.v b/apps/tc-tabled/theories/diamond_unfolded.v
new file mode 100644
index 000000000..f932a25a2
--- /dev/null
+++ b/apps/tc-tabled/theories/diamond_unfolded.v
@@ -0,0 +1,1211 @@
+(* Direct Simple Diamond example *)
+Class TD (n : nat).
+Class RD (n : nat).
+Class LD (n : nat).
+Class BD (n : nat).
+
+Instance BD0 : BD 0 := {}.
+
+Instance BtL0 `{BD 0} : LD 0 := {}.
+Instance BtR0 `{BD 0} : RD 0 := {}.
+Instance LtR0 `{LD 0} : TD 0 := {}.
+Instance RtR0 `{RD 0} : TD 0 := {}.
+Instance Ttb0 `{TD 0} : BD (S 0) := {}.
+
+Instance BtL1 `{BD 1} : LD 1 := {}.
+Instance BtR1 `{BD 1} : RD 1 := {}.
+Instance LtR1 `{LD 1} : TD 1 := {}.
+Instance RtR1 `{RD 1} : TD 1 := {}.
+Instance Ttb1 `{TD 1} : BD (S 1) := {}.
+
+Instance BtL2 `{BD 2} : LD 2 := {}.
+Instance BtR2 `{BD 2} : RD 2 := {}.
+Instance LtR2 `{LD 2} : TD 2 := {}.
+Instance RtR2 `{RD 2} : TD 2 := {}.
+Instance Ttb2 `{TD 2} : BD (S 2) := {}.
+
+Instance BtL3 `{BD 3} : LD 3 := {}.
+Instance BtR3 `{BD 3} : RD 3 := {}.
+Instance LtR3 `{LD 3} : TD 3 := {}.
+Instance RtR3 `{RD 3} : TD 3 := {}.
+Instance Ttb3 `{TD 3} : BD (S 3) := {}.
+
+Instance BtL4 `{BD 4} : LD 4 := {}.
+Instance BtR4 `{BD 4} : RD 4 := {}.
+Instance LtR4 `{LD 4} : TD 4 := {}.
+Instance RtR4 `{RD 4} : TD 4 := {}.
+Instance Ttb4 `{TD 4} : BD (S 4) := {}.
+
+Instance BtL5 `{BD 5} : LD 5 := {}.
+Instance BtR5 `{BD 5} : RD 5 := {}.
+Instance LtR5 `{LD 5} : TD 5 := {}.
+Instance RtR5 `{RD 5} : TD 5 := {}.
+Instance Ttb5 `{TD 5} : BD (S 5) := {}.
+
+Instance BtL6 `{BD 6} : LD 6 := {}.
+Instance BtR6 `{BD 6} : RD 6 := {}.
+Instance LtR6 `{LD 6} : TD 6 := {}.
+Instance RtR6 `{RD 6} : TD 6 := {}.
+Instance Ttb6 `{TD 6} : BD (S 6) := {}.
+
+Instance BtL7 `{BD 7} : LD 7 := {}.
+Instance BtR7 `{BD 7} : RD 7 := {}.
+Instance LtR7 `{LD 7} : TD 7 := {}.
+Instance RtR7 `{RD 7} : TD 7 := {}.
+Instance Ttb7 `{TD 7} : BD (S 7) := {}.
+
+Instance BtL8 `{BD 8} : LD 8 := {}.
+Instance BtR8 `{BD 8} : RD 8 := {}.
+Instance LtR8 `{LD 8} : TD 8 := {}.
+Instance RtR8 `{RD 8} : TD 8 := {}.
+Instance Ttb8 `{TD 8} : BD (S 8) := {}.
+
+Instance BtL9 `{BD 9} : LD 9 := {}.
+Instance BtR9 `{BD 9} : RD 9 := {}.
+Instance LtR9 `{LD 9} : TD 9 := {}.
+Instance RtR9 `{RD 9} : TD 9 := {}.
+Instance Ttb9 `{TD 9} : BD (S 9) := {}.
+
+Instance BtL10 `{BD 10} : LD 10 := {}.
+Instance BtR10 `{BD 10} : RD 10 := {}.
+Instance LtR10 `{LD 10} : TD 10 := {}.
+Instance RtR10 `{RD 10} : TD 10 := {}.
+Instance Ttb10 `{TD 10} : BD (S 10) := {}.
+
+Instance BtL11 `{BD 11} : LD 11 := {}.
+Instance BtR11 `{BD 11} : RD 11 := {}.
+Instance LtR11 `{LD 11} : TD 11 := {}.
+Instance RtR11 `{RD 11} : TD 11 := {}.
+Instance Ttb11 `{TD 11} : BD (S 11) := {}.
+
+Instance BtL12 `{BD 12} : LD 12 := {}.
+Instance BtR12 `{BD 12} : RD 12 := {}.
+Instance LtR12 `{LD 12} : TD 12 := {}.
+Instance RtR12 `{RD 12} : TD 12 := {}.
+Instance Ttb12 `{TD 12} : BD (S 12) := {}.
+
+Instance BtL13 `{BD 13} : LD 13 := {}.
+Instance BtR13 `{BD 13} : RD 13 := {}.
+Instance LtR13 `{LD 13} : TD 13 := {}.
+Instance RtR13 `{RD 13} : TD 13 := {}.
+Instance Ttb13 `{TD 13} : BD (S 13) := {}.
+
+Instance BtL14 `{BD 14} : LD 14 := {}.
+Instance BtR14 `{BD 14} : RD 14 := {}.
+Instance LtR14 `{LD 14} : TD 14 := {}.
+Instance RtR14 `{RD 14} : TD 14 := {}.
+Instance Ttb14 `{TD 14} : BD (S 14) := {}.
+
+Instance BtL15 `{BD 15} : LD 15 := {}.
+Instance BtR15 `{BD 15} : RD 15 := {}.
+Instance LtR15 `{LD 15} : TD 15 := {}.
+Instance RtR15 `{RD 15} : TD 15 := {}.
+Instance Ttb15 `{TD 15} : BD (S 15) := {}.
+
+Instance BtL16 `{BD 16} : LD 16 := {}.
+Instance BtR16 `{BD 16} : RD 16 := {}.
+Instance LtR16 `{LD 16} : TD 16 := {}.
+Instance RtR16 `{RD 16} : TD 16 := {}.
+Instance Ttb16 `{TD 16} : BD (S 16) := {}.
+
+Instance BtL17 `{BD 17} : LD 17 := {}.
+Instance BtR17 `{BD 17} : RD 17 := {}.
+Instance LtR17 `{LD 17} : TD 17 := {}.
+Instance RtR17 `{RD 17} : TD 17 := {}.
+Instance Ttb17 `{TD 17} : BD (S 17) := {}.
+
+Instance BtL18 `{BD 18} : LD 18 := {}.
+Instance BtR18 `{BD 18} : RD 18 := {}.
+Instance LtR18 `{LD 18} : TD 18 := {}.
+Instance RtR18 `{RD 18} : TD 18 := {}.
+Instance Ttb18 `{TD 18} : BD (S 18) := {}.
+
+Instance BtL19 `{BD 19} : LD 19 := {}.
+Instance BtR19 `{BD 19} : RD 19 := {}.
+Instance LtR19 `{LD 19} : TD 19 := {}.
+Instance RtR19 `{RD 19} : TD 19 := {}.
+Instance Ttb19 `{TD 19} : BD (S 19) := {}.
+
+Instance BtL20 `{BD 20} : LD 20 := {}.
+Instance BtR20 `{BD 20} : RD 20 := {}.
+Instance LtR20 `{LD 20} : TD 20 := {}.
+Instance RtR20 `{RD 20} : TD 20 := {}.
+Instance Ttb20 `{TD 20} : BD (S 20) := {}.
+
+Instance BtL21 `{BD 21} : LD 21 := {}.
+Instance BtR21 `{BD 21} : RD 21 := {}.
+Instance LtR21 `{LD 21} : TD 21 := {}.
+Instance RtR21 `{RD 21} : TD 21 := {}.
+Instance Ttb21 `{TD 21} : BD (S 21) := {}.
+
+Instance BtL22 `{BD 22} : LD 22 := {}.
+Instance BtR22 `{BD 22} : RD 22 := {}.
+Instance LtR22 `{LD 22} : TD 22 := {}.
+Instance RtR22 `{RD 22} : TD 22 := {}.
+Instance Ttb22 `{TD 22} : BD (S 22) := {}.
+
+Instance BtL23 `{BD 23} : LD 23 := {}.
+Instance BtR23 `{BD 23} : RD 23 := {}.
+Instance LtR23 `{LD 23} : TD 23 := {}.
+Instance RtR23 `{RD 23} : TD 23 := {}.
+Instance Ttb23 `{TD 23} : BD (S 23) := {}.
+
+Instance BtL24 `{BD 24} : LD 24 := {}.
+Instance BtR24 `{BD 24} : RD 24 := {}.
+Instance LtR24 `{LD 24} : TD 24 := {}.
+Instance RtR24 `{RD 24} : TD 24 := {}.
+Instance Ttb24 `{TD 24} : BD (S 24) := {}.
+
+Instance BtL25 `{BD 25} : LD 25 := {}.
+Instance BtR25 `{BD 25} : RD 25 := {}.
+Instance LtR25 `{LD 25} : TD 25 := {}.
+Instance RtR25 `{RD 25} : TD 25 := {}.
+Instance Ttb25 `{TD 25} : BD (S 25) := {}.
+
+Instance BtL26 `{BD 26} : LD 26 := {}.
+Instance BtR26 `{BD 26} : RD 26 := {}.
+Instance LtR26 `{LD 26} : TD 26 := {}.
+Instance RtR26 `{RD 26} : TD 26 := {}.
+Instance Ttb26 `{TD 26} : BD (S 26) := {}.
+
+Instance BtL27 `{BD 27} : LD 27 := {}.
+Instance BtR27 `{BD 27} : RD 27 := {}.
+Instance LtR27 `{LD 27} : TD 27 := {}.
+Instance RtR27 `{RD 27} : TD 27 := {}.
+Instance Ttb27 `{TD 27} : BD (S 27) := {}.
+
+Instance BtL28 `{BD 28} : LD 28 := {}.
+Instance BtR28 `{BD 28} : RD 28 := {}.
+Instance LtR28 `{LD 28} : TD 28 := {}.
+Instance RtR28 `{RD 28} : TD 28 := {}.
+Instance Ttb28 `{TD 28} : BD (S 28) := {}.
+
+Instance BtL29 `{BD 29} : LD 29 := {}.
+Instance BtR29 `{BD 29} : RD 29 := {}.
+Instance LtR29 `{LD 29} : TD 29 := {}.
+Instance RtR29 `{RD 29} : TD 29 := {}.
+Instance Ttb29 `{TD 29} : BD (S 29) := {}.
+
+Instance BtL30 `{BD 30} : LD 30 := {}.
+Instance BtR30 `{BD 30} : RD 30 := {}.
+Instance LtR30 `{LD 30} : TD 30 := {}.
+Instance RtR30 `{RD 30} : TD 30 := {}.
+Instance Ttb30 `{TD 30} : BD (S 30) := {}.
+
+Instance BtL31 `{BD 31} : LD 31 := {}.
+Instance BtR31 `{BD 31} : RD 31 := {}.
+Instance LtR31 `{LD 31} : TD 31 := {}.
+Instance RtR31 `{RD 31} : TD 31 := {}.
+Instance Ttb31 `{TD 31} : BD (S 31) := {}.
+
+Instance BtL32 `{BD 32} : LD 32 := {}.
+Instance BtR32 `{BD 32} : RD 32 := {}.
+Instance LtR32 `{LD 32} : TD 32 := {}.
+Instance RtR32 `{RD 32} : TD 32 := {}.
+Instance Ttb32 `{TD 32} : BD (S 32) := {}.
+
+Instance BtL33 `{BD 33} : LD 33 := {}.
+Instance BtR33 `{BD 33} : RD 33 := {}.
+Instance LtR33 `{LD 33} : TD 33 := {}.
+Instance RtR33 `{RD 33} : TD 33 := {}.
+Instance Ttb33 `{TD 33} : BD (S 33) := {}.
+
+Instance BtL34 `{BD 34} : LD 34 := {}.
+Instance BtR34 `{BD 34} : RD 34 := {}.
+Instance LtR34 `{LD 34} : TD 34 := {}.
+Instance RtR34 `{RD 34} : TD 34 := {}.
+Instance Ttb34 `{TD 34} : BD (S 34) := {}.
+
+Instance BtL35 `{BD 35} : LD 35 := {}.
+Instance BtR35 `{BD 35} : RD 35 := {}.
+Instance LtR35 `{LD 35} : TD 35 := {}.
+Instance RtR35 `{RD 35} : TD 35 := {}.
+Instance Ttb35 `{TD 35} : BD (S 35) := {}.
+
+Instance BtL36 `{BD 36} : LD 36 := {}.
+Instance BtR36 `{BD 36} : RD 36 := {}.
+Instance LtR36 `{LD 36} : TD 36 := {}.
+Instance RtR36 `{RD 36} : TD 36 := {}.
+Instance Ttb36 `{TD 36} : BD (S 36) := {}.
+
+Instance BtL37 `{BD 37} : LD 37 := {}.
+Instance BtR37 `{BD 37} : RD 37 := {}.
+Instance LtR37 `{LD 37} : TD 37 := {}.
+Instance RtR37 `{RD 37} : TD 37 := {}.
+Instance Ttb37 `{TD 37} : BD (S 37) := {}.
+
+Instance BtL38 `{BD 38} : LD 38 := {}.
+Instance BtR38 `{BD 38} : RD 38 := {}.
+Instance LtR38 `{LD 38} : TD 38 := {}.
+Instance RtR38 `{RD 38} : TD 38 := {}.
+Instance Ttb38 `{TD 38} : BD (S 38) := {}.
+
+Instance BtL39 `{BD 39} : LD 39 := {}.
+Instance BtR39 `{BD 39} : RD 39 := {}.
+Instance LtR39 `{LD 39} : TD 39 := {}.
+Instance RtR39 `{RD 39} : TD 39 := {}.
+Instance Ttb39 `{TD 39} : BD (S 39) := {}.
+
+Instance BtL40 `{BD 40} : LD 40 := {}.
+Instance BtR40 `{BD 40} : RD 40 := {}.
+Instance LtR40 `{LD 40} : TD 40 := {}.
+Instance RtR40 `{RD 40} : TD 40 := {}.
+Instance Ttb40 `{TD 40} : BD (S 40) := {}.
+
+Instance BtL41 `{BD 41} : LD 41 := {}.
+Instance BtR41 `{BD 41} : RD 41 := {}.
+Instance LtR41 `{LD 41} : TD 41 := {}.
+Instance RtR41 `{RD 41} : TD 41 := {}.
+Instance Ttb41 `{TD 41} : BD (S 41) := {}.
+
+Instance BtL42 `{BD 42} : LD 42 := {}.
+Instance BtR42 `{BD 42} : RD 42 := {}.
+Instance LtR42 `{LD 42} : TD 42 := {}.
+Instance RtR42 `{RD 42} : TD 42 := {}.
+Instance Ttb42 `{TD 42} : BD (S 42) := {}.
+
+Instance BtL43 `{BD 43} : LD 43 := {}.
+Instance BtR43 `{BD 43} : RD 43 := {}.
+Instance LtR43 `{LD 43} : TD 43 := {}.
+Instance RtR43 `{RD 43} : TD 43 := {}.
+Instance Ttb43 `{TD 43} : BD (S 43) := {}.
+
+Instance BtL44 `{BD 44} : LD 44 := {}.
+Instance BtR44 `{BD 44} : RD 44 := {}.
+Instance LtR44 `{LD 44} : TD 44 := {}.
+Instance RtR44 `{RD 44} : TD 44 := {}.
+Instance Ttb44 `{TD 44} : BD (S 44) := {}.
+
+Instance BtL45 `{BD 45} : LD 45 := {}.
+Instance BtR45 `{BD 45} : RD 45 := {}.
+Instance LtR45 `{LD 45} : TD 45 := {}.
+Instance RtR45 `{RD 45} : TD 45 := {}.
+Instance Ttb45 `{TD 45} : BD (S 45) := {}.
+
+Instance BtL46 `{BD 46} : LD 46 := {}.
+Instance BtR46 `{BD 46} : RD 46 := {}.
+Instance LtR46 `{LD 46} : TD 46 := {}.
+Instance RtR46 `{RD 46} : TD 46 := {}.
+Instance Ttb46 `{TD 46} : BD (S 46) := {}.
+
+Instance BtL47 `{BD 47} : LD 47 := {}.
+Instance BtR47 `{BD 47} : RD 47 := {}.
+Instance LtR47 `{LD 47} : TD 47 := {}.
+Instance RtR47 `{RD 47} : TD 47 := {}.
+Instance Ttb47 `{TD 47} : BD (S 47) := {}.
+
+Instance BtL48 `{BD 48} : LD 48 := {}.
+Instance BtR48 `{BD 48} : RD 48 := {}.
+Instance LtR48 `{LD 48} : TD 48 := {}.
+Instance RtR48 `{RD 48} : TD 48 := {}.
+Instance Ttb48 `{TD 48} : BD (S 48) := {}.
+
+Instance BtL49 `{BD 49} : LD 49 := {}.
+Instance BtR49 `{BD 49} : RD 49 := {}.
+Instance LtR49 `{LD 49} : TD 49 := {}.
+Instance RtR49 `{RD 49} : TD 49 := {}.
+Instance Ttb49 `{TD 49} : BD (S 49) := {}.
+
+Instance BtL50 `{BD 50} : LD 50 := {}.
+Instance BtR50 `{BD 50} : RD 50 := {}.
+Instance LtR50 `{LD 50} : TD 50 := {}.
+Instance RtR50 `{RD 50} : TD 50 := {}.
+Instance Ttb50 `{TD 50} : BD (S 50) := {}.
+
+Instance BtL51 `{BD 51} : LD 51 := {}.
+Instance BtR51 `{BD 51} : RD 51 := {}.
+Instance LtR51 `{LD 51} : TD 51 := {}.
+Instance RtR51 `{RD 51} : TD 51 := {}.
+Instance Ttb51 `{TD 51} : BD (S 51) := {}.
+
+Instance BtL52 `{BD 52} : LD 52 := {}.
+Instance BtR52 `{BD 52} : RD 52 := {}.
+Instance LtR52 `{LD 52} : TD 52 := {}.
+Instance RtR52 `{RD 52} : TD 52 := {}.
+Instance Ttb52 `{TD 52} : BD (S 52) := {}.
+
+Instance BtL53 `{BD 53} : LD 53 := {}.
+Instance BtR53 `{BD 53} : RD 53 := {}.
+Instance LtR53 `{LD 53} : TD 53 := {}.
+Instance RtR53 `{RD 53} : TD 53 := {}.
+Instance Ttb53 `{TD 53} : BD (S 53) := {}.
+
+Instance BtL54 `{BD 54} : LD 54 := {}.
+Instance BtR54 `{BD 54} : RD 54 := {}.
+Instance LtR54 `{LD 54} : TD 54 := {}.
+Instance RtR54 `{RD 54} : TD 54 := {}.
+Instance Ttb54 `{TD 54} : BD (S 54) := {}.
+
+Instance BtL55 `{BD 55} : LD 55 := {}.
+Instance BtR55 `{BD 55} : RD 55 := {}.
+Instance LtR55 `{LD 55} : TD 55 := {}.
+Instance RtR55 `{RD 55} : TD 55 := {}.
+Instance Ttb55 `{TD 55} : BD (S 55) := {}.
+
+Instance BtL56 `{BD 56} : LD 56 := {}.
+Instance BtR56 `{BD 56} : RD 56 := {}.
+Instance LtR56 `{LD 56} : TD 56 := {}.
+Instance RtR56 `{RD 56} : TD 56 := {}.
+Instance Ttb56 `{TD 56} : BD (S 56) := {}.
+
+Instance BtL57 `{BD 57} : LD 57 := {}.
+Instance BtR57 `{BD 57} : RD 57 := {}.
+Instance LtR57 `{LD 57} : TD 57 := {}.
+Instance RtR57 `{RD 57} : TD 57 := {}.
+Instance Ttb57 `{TD 57} : BD (S 57) := {}.
+
+Instance BtL58 `{BD 58} : LD 58 := {}.
+Instance BtR58 `{BD 58} : RD 58 := {}.
+Instance LtR58 `{LD 58} : TD 58 := {}.
+Instance RtR58 `{RD 58} : TD 58 := {}.
+Instance Ttb58 `{TD 58} : BD (S 58) := {}.
+
+Instance BtL59 `{BD 59} : LD 59 := {}.
+Instance BtR59 `{BD 59} : RD 59 := {}.
+Instance LtR59 `{LD 59} : TD 59 := {}.
+Instance RtR59 `{RD 59} : TD 59 := {}.
+Instance Ttb59 `{TD 59} : BD (S 59) := {}.
+
+Instance BtL60 `{BD 60} : LD 60 := {}.
+Instance BtR60 `{BD 60} : RD 60 := {}.
+Instance LtR60 `{LD 60} : TD 60 := {}.
+Instance RtR60 `{RD 60} : TD 60 := {}.
+Instance Ttb60 `{TD 60} : BD (S 60) := {}.
+
+Instance BtL61 `{BD 61} : LD 61 := {}.
+Instance BtR61 `{BD 61} : RD 61 := {}.
+Instance LtR61 `{LD 61} : TD 61 := {}.
+Instance RtR61 `{RD 61} : TD 61 := {}.
+Instance Ttb61 `{TD 61} : BD (S 61) := {}.
+
+Instance BtL62 `{BD 62} : LD 62 := {}.
+Instance BtR62 `{BD 62} : RD 62 := {}.
+Instance LtR62 `{LD 62} : TD 62 := {}.
+Instance RtR62 `{RD 62} : TD 62 := {}.
+Instance Ttb62 `{TD 62} : BD (S 62) := {}.
+
+Instance BtL63 `{BD 63} : LD 63 := {}.
+Instance BtR63 `{BD 63} : RD 63 := {}.
+Instance LtR63 `{LD 63} : TD 63 := {}.
+Instance RtR63 `{RD 63} : TD 63 := {}.
+Instance Ttb63 `{TD 63} : BD (S 63) := {}.
+
+Instance BtL64 `{BD 64} : LD 64 := {}.
+Instance BtR64 `{BD 64} : RD 64 := {}.
+Instance LtR64 `{LD 64} : TD 64 := {}.
+Instance RtR64 `{RD 64} : TD 64 := {}.
+Instance Ttb64 `{TD 64} : BD (S 64) := {}.
+
+Instance BtL65 `{BD 65} : LD 65 := {}.
+Instance BtR65 `{BD 65} : RD 65 := {}.
+Instance LtR65 `{LD 65} : TD 65 := {}.
+Instance RtR65 `{RD 65} : TD 65 := {}.
+Instance Ttb65 `{TD 65} : BD (S 65) := {}.
+
+Instance BtL66 `{BD 66} : LD 66 := {}.
+Instance BtR66 `{BD 66} : RD 66 := {}.
+Instance LtR66 `{LD 66} : TD 66 := {}.
+Instance RtR66 `{RD 66} : TD 66 := {}.
+Instance Ttb66 `{TD 66} : BD (S 66) := {}.
+
+Instance BtL67 `{BD 67} : LD 67 := {}.
+Instance BtR67 `{BD 67} : RD 67 := {}.
+Instance LtR67 `{LD 67} : TD 67 := {}.
+Instance RtR67 `{RD 67} : TD 67 := {}.
+Instance Ttb67 `{TD 67} : BD (S 67) := {}.
+
+Instance BtL68 `{BD 68} : LD 68 := {}.
+Instance BtR68 `{BD 68} : RD 68 := {}.
+Instance LtR68 `{LD 68} : TD 68 := {}.
+Instance RtR68 `{RD 68} : TD 68 := {}.
+Instance Ttb68 `{TD 68} : BD (S 68) := {}.
+
+Instance BtL69 `{BD 69} : LD 69 := {}.
+Instance BtR69 `{BD 69} : RD 69 := {}.
+Instance LtR69 `{LD 69} : TD 69 := {}.
+Instance RtR69 `{RD 69} : TD 69 := {}.
+Instance Ttb69 `{TD 69} : BD (S 69) := {}.
+
+Instance BtL70 `{BD 70} : LD 70 := {}.
+Instance BtR70 `{BD 70} : RD 70 := {}.
+Instance LtR70 `{LD 70} : TD 70 := {}.
+Instance RtR70 `{RD 70} : TD 70 := {}.
+Instance Ttb70 `{TD 70} : BD (S 70) := {}.
+
+Instance BtL71 `{BD 71} : LD 71 := {}.
+Instance BtR71 `{BD 71} : RD 71 := {}.
+Instance LtR71 `{LD 71} : TD 71 := {}.
+Instance RtR71 `{RD 71} : TD 71 := {}.
+Instance Ttb71 `{TD 71} : BD (S 71) := {}.
+
+Instance BtL72 `{BD 72} : LD 72 := {}.
+Instance BtR72 `{BD 72} : RD 72 := {}.
+Instance LtR72 `{LD 72} : TD 72 := {}.
+Instance RtR72 `{RD 72} : TD 72 := {}.
+Instance Ttb72 `{TD 72} : BD (S 72) := {}.
+
+Instance BtL73 `{BD 73} : LD 73 := {}.
+Instance BtR73 `{BD 73} : RD 73 := {}.
+Instance LtR73 `{LD 73} : TD 73 := {}.
+Instance RtR73 `{RD 73} : TD 73 := {}.
+Instance Ttb73 `{TD 73} : BD (S 73) := {}.
+
+Instance BtL74 `{BD 74} : LD 74 := {}.
+Instance BtR74 `{BD 74} : RD 74 := {}.
+Instance LtR74 `{LD 74} : TD 74 := {}.
+Instance RtR74 `{RD 74} : TD 74 := {}.
+Instance Ttb74 `{TD 74} : BD (S 74) := {}.
+
+Instance BtL75 `{BD 75} : LD 75 := {}.
+Instance BtR75 `{BD 75} : RD 75 := {}.
+Instance LtR75 `{LD 75} : TD 75 := {}.
+Instance RtR75 `{RD 75} : TD 75 := {}.
+Instance Ttb75 `{TD 75} : BD (S 75) := {}.
+
+Instance BtL76 `{BD 76} : LD 76 := {}.
+Instance BtR76 `{BD 76} : RD 76 := {}.
+Instance LtR76 `{LD 76} : TD 76 := {}.
+Instance RtR76 `{RD 76} : TD 76 := {}.
+Instance Ttb76 `{TD 76} : BD (S 76) := {}.
+
+Instance BtL77 `{BD 77} : LD 77 := {}.
+Instance BtR77 `{BD 77} : RD 77 := {}.
+Instance LtR77 `{LD 77} : TD 77 := {}.
+Instance RtR77 `{RD 77} : TD 77 := {}.
+Instance Ttb77 `{TD 77} : BD (S 77) := {}.
+
+Instance BtL78 `{BD 78} : LD 78 := {}.
+Instance BtR78 `{BD 78} : RD 78 := {}.
+Instance LtR78 `{LD 78} : TD 78 := {}.
+Instance RtR78 `{RD 78} : TD 78 := {}.
+Instance Ttb78 `{TD 78} : BD (S 78) := {}.
+
+Instance BtL79 `{BD 79} : LD 79 := {}.
+Instance BtR79 `{BD 79} : RD 79 := {}.
+Instance LtR79 `{LD 79} : TD 79 := {}.
+Instance RtR79 `{RD 79} : TD 79 := {}.
+Instance Ttb79 `{TD 79} : BD (S 79) := {}.
+
+Instance BtL80 `{BD 80} : LD 80 := {}.
+Instance BtR80 `{BD 80} : RD 80 := {}.
+Instance LtR80 `{LD 80} : TD 80 := {}.
+Instance RtR80 `{RD 80} : TD 80 := {}.
+Instance Ttb80 `{TD 80} : BD (S 80) := {}.
+
+Instance BtL81 `{BD 81} : LD 81 := {}.
+Instance BtR81 `{BD 81} : RD 81 := {}.
+Instance LtR81 `{LD 81} : TD 81 := {}.
+Instance RtR81 `{RD 81} : TD 81 := {}.
+Instance Ttb81 `{TD 81} : BD (S 81) := {}.
+
+Instance BtL82 `{BD 82} : LD 82 := {}.
+Instance BtR82 `{BD 82} : RD 82 := {}.
+Instance LtR82 `{LD 82} : TD 82 := {}.
+Instance RtR82 `{RD 82} : TD 82 := {}.
+Instance Ttb82 `{TD 82} : BD (S 82) := {}.
+
+Instance BtL83 `{BD 83} : LD 83 := {}.
+Instance BtR83 `{BD 83} : RD 83 := {}.
+Instance LtR83 `{LD 83} : TD 83 := {}.
+Instance RtR83 `{RD 83} : TD 83 := {}.
+Instance Ttb83 `{TD 83} : BD (S 83) := {}.
+
+Instance BtL84 `{BD 84} : LD 84 := {}.
+Instance BtR84 `{BD 84} : RD 84 := {}.
+Instance LtR84 `{LD 84} : TD 84 := {}.
+Instance RtR84 `{RD 84} : TD 84 := {}.
+Instance Ttb84 `{TD 84} : BD (S 84) := {}.
+
+Instance BtL85 `{BD 85} : LD 85 := {}.
+Instance BtR85 `{BD 85} : RD 85 := {}.
+Instance LtR85 `{LD 85} : TD 85 := {}.
+Instance RtR85 `{RD 85} : TD 85 := {}.
+Instance Ttb85 `{TD 85} : BD (S 85) := {}.
+
+Instance BtL86 `{BD 86} : LD 86 := {}.
+Instance BtR86 `{BD 86} : RD 86 := {}.
+Instance LtR86 `{LD 86} : TD 86 := {}.
+Instance RtR86 `{RD 86} : TD 86 := {}.
+Instance Ttb86 `{TD 86} : BD (S 86) := {}.
+
+Instance BtL87 `{BD 87} : LD 87 := {}.
+Instance BtR87 `{BD 87} : RD 87 := {}.
+Instance LtR87 `{LD 87} : TD 87 := {}.
+Instance RtR87 `{RD 87} : TD 87 := {}.
+Instance Ttb87 `{TD 87} : BD (S 87) := {}.
+
+Instance BtL88 `{BD 88} : LD 88 := {}.
+Instance BtR88 `{BD 88} : RD 88 := {}.
+Instance LtR88 `{LD 88} : TD 88 := {}.
+Instance RtR88 `{RD 88} : TD 88 := {}.
+Instance Ttb88 `{TD 88} : BD (S 88) := {}.
+
+Instance BtL89 `{BD 89} : LD 89 := {}.
+Instance BtR89 `{BD 89} : RD 89 := {}.
+Instance LtR89 `{LD 89} : TD 89 := {}.
+Instance RtR89 `{RD 89} : TD 89 := {}.
+Instance Ttb89 `{TD 89} : BD (S 89) := {}.
+
+Instance BtL90 `{BD 90} : LD 90 := {}.
+Instance BtR90 `{BD 90} : RD 90 := {}.
+Instance LtR90 `{LD 90} : TD 90 := {}.
+Instance RtR90 `{RD 90} : TD 90 := {}.
+Instance Ttb90 `{TD 90} : BD (S 90) := {}.
+
+Instance BtL91 `{BD 91} : LD 91 := {}.
+Instance BtR91 `{BD 91} : RD 91 := {}.
+Instance LtR91 `{LD 91} : TD 91 := {}.
+Instance RtR91 `{RD 91} : TD 91 := {}.
+Instance Ttb91 `{TD 91} : BD (S 91) := {}.
+
+Instance BtL92 `{BD 92} : LD 92 := {}.
+Instance BtR92 `{BD 92} : RD 92 := {}.
+Instance LtR92 `{LD 92} : TD 92 := {}.
+Instance RtR92 `{RD 92} : TD 92 := {}.
+Instance Ttb92 `{TD 92} : BD (S 92) := {}.
+
+Instance BtL93 `{BD 93} : LD 93 := {}.
+Instance BtR93 `{BD 93} : RD 93 := {}.
+Instance LtR93 `{LD 93} : TD 93 := {}.
+Instance RtR93 `{RD 93} : TD 93 := {}.
+Instance Ttb93 `{TD 93} : BD (S 93) := {}.
+
+Instance BtL94 `{BD 94} : LD 94 := {}.
+Instance BtR94 `{BD 94} : RD 94 := {}.
+Instance LtR94 `{LD 94} : TD 94 := {}.
+Instance RtR94 `{RD 94} : TD 94 := {}.
+Instance Ttb94 `{TD 94} : BD (S 94) := {}.
+
+Instance BtL95 `{BD 95} : LD 95 := {}.
+Instance BtR95 `{BD 95} : RD 95 := {}.
+Instance LtR95 `{LD 95} : TD 95 := {}.
+Instance RtR95 `{RD 95} : TD 95 := {}.
+Instance Ttb95 `{TD 95} : BD (S 95) := {}.
+
+Instance BtL96 `{BD 96} : LD 96 := {}.
+Instance BtR96 `{BD 96} : RD 96 := {}.
+Instance LtR96 `{LD 96} : TD 96 := {}.
+Instance RtR96 `{RD 96} : TD 96 := {}.
+Instance Ttb96 `{TD 96} : BD (S 96) := {}.
+
+Instance BtL97 `{BD 97} : LD 97 := {}.
+Instance BtR97 `{BD 97} : RD 97 := {}.
+Instance LtR97 `{LD 97} : TD 97 := {}.
+Instance RtR97 `{RD 97} : TD 97 := {}.
+Instance Ttb97 `{TD 97} : BD (S 97) := {}.
+
+Instance BtL98 `{BD 98} : LD 98 := {}.
+Instance BtR98 `{BD 98} : RD 98 := {}.
+Instance LtR98 `{LD 98} : TD 98 := {}.
+Instance RtR98 `{RD 98} : TD 98 := {}.
+Instance Ttb98 `{TD 98} : BD (S 98) := {}.
+
+Instance BtL99 `{BD 99} : LD 99 := {}.
+Instance BtR99 `{BD 99} : RD 99 := {}.
+Instance LtR99 `{LD 99} : TD 99 := {}.
+Instance RtR99 `{RD 99} : TD 99 := {}.
+Instance Ttb99 `{TD 99} : BD (S 99) := {}.
+
+Instance BtL100 `{BD 100} : LD 100 := {}.
+Instance BtR100 `{BD 100} : RD 100 := {}.
+Instance LtR100 `{LD 100} : TD 100 := {}.
+Instance RtR100 `{RD 100} : TD 100 := {}.
+Instance Ttb100 `{TD 100} : BD (S 100) := {}.
+
+Instance BtL101 `{BD 101} : LD 101 := {}.
+Instance BtR101 `{BD 101} : RD 101 := {}.
+Instance LtR101 `{LD 101} : TD 101 := {}.
+Instance RtR101 `{RD 101} : TD 101 := {}.
+Instance Ttb101 `{TD 101} : BD (S 101) := {}.
+
+Instance BtL102 `{BD 102} : LD 102 := {}.
+Instance BtR102 `{BD 102} : RD 102 := {}.
+Instance LtR102 `{LD 102} : TD 102 := {}.
+Instance RtR102 `{RD 102} : TD 102 := {}.
+Instance Ttb102 `{TD 102} : BD (S 102) := {}.
+
+Instance BtL103 `{BD 103} : LD 103 := {}.
+Instance BtR103 `{BD 103} : RD 103 := {}.
+Instance LtR103 `{LD 103} : TD 103 := {}.
+Instance RtR103 `{RD 103} : TD 103 := {}.
+Instance Ttb103 `{TD 103} : BD (S 103) := {}.
+
+Instance BtL104 `{BD 104} : LD 104 := {}.
+Instance BtR104 `{BD 104} : RD 104 := {}.
+Instance LtR104 `{LD 104} : TD 104 := {}.
+Instance RtR104 `{RD 104} : TD 104 := {}.
+Instance Ttb104 `{TD 104} : BD (S 104) := {}.
+
+Instance BtL105 `{BD 105} : LD 105 := {}.
+Instance BtR105 `{BD 105} : RD 105 := {}.
+Instance LtR105 `{LD 105} : TD 105 := {}.
+Instance RtR105 `{RD 105} : TD 105 := {}.
+Instance Ttb105 `{TD 105} : BD (S 105) := {}.
+
+Instance BtL106 `{BD 106} : LD 106 := {}.
+Instance BtR106 `{BD 106} : RD 106 := {}.
+Instance LtR106 `{LD 106} : TD 106 := {}.
+Instance RtR106 `{RD 106} : TD 106 := {}.
+Instance Ttb106 `{TD 106} : BD (S 106) := {}.
+
+Instance BtL107 `{BD 107} : LD 107 := {}.
+Instance BtR107 `{BD 107} : RD 107 := {}.
+Instance LtR107 `{LD 107} : TD 107 := {}.
+Instance RtR107 `{RD 107} : TD 107 := {}.
+Instance Ttb107 `{TD 107} : BD (S 107) := {}.
+
+Instance BtL108 `{BD 108} : LD 108 := {}.
+Instance BtR108 `{BD 108} : RD 108 := {}.
+Instance LtR108 `{LD 108} : TD 108 := {}.
+Instance RtR108 `{RD 108} : TD 108 := {}.
+Instance Ttb108 `{TD 108} : BD (S 108) := {}.
+
+Instance BtL109 `{BD 109} : LD 109 := {}.
+Instance BtR109 `{BD 109} : RD 109 := {}.
+Instance LtR109 `{LD 109} : TD 109 := {}.
+Instance RtR109 `{RD 109} : TD 109 := {}.
+Instance Ttb109 `{TD 109} : BD (S 109) := {}.
+
+Instance BtL110 `{BD 110} : LD 110 := {}.
+Instance BtR110 `{BD 110} : RD 110 := {}.
+Instance LtR110 `{LD 110} : TD 110 := {}.
+Instance RtR110 `{RD 110} : TD 110 := {}.
+Instance Ttb110 `{TD 110} : BD (S 110) := {}.
+
+Instance BtL111 `{BD 111} : LD 111 := {}.
+Instance BtR111 `{BD 111} : RD 111 := {}.
+Instance LtR111 `{LD 111} : TD 111 := {}.
+Instance RtR111 `{RD 111} : TD 111 := {}.
+Instance Ttb111 `{TD 111} : BD (S 111) := {}.
+
+Instance BtL112 `{BD 112} : LD 112 := {}.
+Instance BtR112 `{BD 112} : RD 112 := {}.
+Instance LtR112 `{LD 112} : TD 112 := {}.
+Instance RtR112 `{RD 112} : TD 112 := {}.
+Instance Ttb112 `{TD 112} : BD (S 112) := {}.
+
+Instance BtL113 `{BD 113} : LD 113 := {}.
+Instance BtR113 `{BD 113} : RD 113 := {}.
+Instance LtR113 `{LD 113} : TD 113 := {}.
+Instance RtR113 `{RD 113} : TD 113 := {}.
+Instance Ttb113 `{TD 113} : BD (S 113) := {}.
+
+Instance BtL114 `{BD 114} : LD 114 := {}.
+Instance BtR114 `{BD 114} : RD 114 := {}.
+Instance LtR114 `{LD 114} : TD 114 := {}.
+Instance RtR114 `{RD 114} : TD 114 := {}.
+Instance Ttb114 `{TD 114} : BD (S 114) := {}.
+
+Instance BtL115 `{BD 115} : LD 115 := {}.
+Instance BtR115 `{BD 115} : RD 115 := {}.
+Instance LtR115 `{LD 115} : TD 115 := {}.
+Instance RtR115 `{RD 115} : TD 115 := {}.
+Instance Ttb115 `{TD 115} : BD (S 115) := {}.
+
+Instance BtL116 `{BD 116} : LD 116 := {}.
+Instance BtR116 `{BD 116} : RD 116 := {}.
+Instance LtR116 `{LD 116} : TD 116 := {}.
+Instance RtR116 `{RD 116} : TD 116 := {}.
+Instance Ttb116 `{TD 116} : BD (S 116) := {}.
+
+Instance BtL117 `{BD 117} : LD 117 := {}.
+Instance BtR117 `{BD 117} : RD 117 := {}.
+Instance LtR117 `{LD 117} : TD 117 := {}.
+Instance RtR117 `{RD 117} : TD 117 := {}.
+Instance Ttb117 `{TD 117} : BD (S 117) := {}.
+
+Instance BtL118 `{BD 118} : LD 118 := {}.
+Instance BtR118 `{BD 118} : RD 118 := {}.
+Instance LtR118 `{LD 118} : TD 118 := {}.
+Instance RtR118 `{RD 118} : TD 118 := {}.
+Instance Ttb118 `{TD 118} : BD (S 118) := {}.
+
+Instance BtL119 `{BD 119} : LD 119 := {}.
+Instance BtR119 `{BD 119} : RD 119 := {}.
+Instance LtR119 `{LD 119} : TD 119 := {}.
+Instance RtR119 `{RD 119} : TD 119 := {}.
+Instance Ttb119 `{TD 119} : BD (S 119) := {}.
+
+Instance BtL120 `{BD 120} : LD 120 := {}.
+Instance BtR120 `{BD 120} : RD 120 := {}.
+Instance LtR120 `{LD 120} : TD 120 := {}.
+Instance RtR120 `{RD 120} : TD 120 := {}.
+Instance Ttb120 `{TD 120} : BD (S 120) := {}.
+
+Instance BtL121 `{BD 121} : LD 121 := {}.
+Instance BtR121 `{BD 121} : RD 121 := {}.
+Instance LtR121 `{LD 121} : TD 121 := {}.
+Instance RtR121 `{RD 121} : TD 121 := {}.
+Instance Ttb121 `{TD 121} : BD (S 121) := {}.
+
+Instance BtL122 `{BD 122} : LD 122 := {}.
+Instance BtR122 `{BD 122} : RD 122 := {}.
+Instance LtR122 `{LD 122} : TD 122 := {}.
+Instance RtR122 `{RD 122} : TD 122 := {}.
+Instance Ttb122 `{TD 122} : BD (S 122) := {}.
+
+Instance BtL123 `{BD 123} : LD 123 := {}.
+Instance BtR123 `{BD 123} : RD 123 := {}.
+Instance LtR123 `{LD 123} : TD 123 := {}.
+Instance RtR123 `{RD 123} : TD 123 := {}.
+Instance Ttb123 `{TD 123} : BD (S 123) := {}.
+
+Instance BtL124 `{BD 124} : LD 124 := {}.
+Instance BtR124 `{BD 124} : RD 124 := {}.
+Instance LtR124 `{LD 124} : TD 124 := {}.
+Instance RtR124 `{RD 124} : TD 124 := {}.
+Instance Ttb124 `{TD 124} : BD (S 124) := {}.
+
+Instance BtL125 `{BD 125} : LD 125 := {}.
+Instance BtR125 `{BD 125} : RD 125 := {}.
+Instance LtR125 `{LD 125} : TD 125 := {}.
+Instance RtR125 `{RD 125} : TD 125 := {}.
+Instance Ttb125 `{TD 125} : BD (S 125) := {}.
+
+Instance BtL126 `{BD 126} : LD 126 := {}.
+Instance BtR126 `{BD 126} : RD 126 := {}.
+Instance LtR126 `{LD 126} : TD 126 := {}.
+Instance RtR126 `{RD 126} : TD 126 := {}.
+Instance Ttb126 `{TD 126} : BD (S 126) := {}.
+
+Instance BtL127 `{BD 127} : LD 127 := {}.
+Instance BtR127 `{BD 127} : RD 127 := {}.
+Instance LtR127 `{LD 127} : TD 127 := {}.
+Instance RtR127 `{RD 127} : TD 127 := {}.
+Instance Ttb127 `{TD 127} : BD (S 127) := {}.
+
+Instance BtL128 `{BD 128} : LD 128 := {}.
+Instance BtR128 `{BD 128} : RD 128 := {}.
+Instance LtR128 `{LD 128} : TD 128 := {}.
+Instance RtR128 `{RD 128} : TD 128 := {}.
+Instance Ttb128 `{TD 128} : BD (S 128) := {}.
+
+Instance BtL129 `{BD 129} : LD 129 := {}.
+Instance BtR129 `{BD 129} : RD 129 := {}.
+Instance LtR129 `{LD 129} : TD 129 := {}.
+Instance RtR129 `{RD 129} : TD 129 := {}.
+Instance Ttb129 `{TD 129} : BD (S 129) := {}.
+
+Instance BtL130 `{BD 130} : LD 130 := {}.
+Instance BtR130 `{BD 130} : RD 130 := {}.
+Instance LtR130 `{LD 130} : TD 130 := {}.
+Instance RtR130 `{RD 130} : TD 130 := {}.
+Instance Ttb130 `{TD 130} : BD (S 130) := {}.
+
+Instance BtL131 `{BD 131} : LD 131 := {}.
+Instance BtR131 `{BD 131} : RD 131 := {}.
+Instance LtR131 `{LD 131} : TD 131 := {}.
+Instance RtR131 `{RD 131} : TD 131 := {}.
+Instance Ttb131 `{TD 131} : BD (S 131) := {}.
+
+Instance BtL132 `{BD 132} : LD 132 := {}.
+Instance BtR132 `{BD 132} : RD 132 := {}.
+Instance LtR132 `{LD 132} : TD 132 := {}.
+Instance RtR132 `{RD 132} : TD 132 := {}.
+Instance Ttb132 `{TD 132} : BD (S 132) := {}.
+
+Instance BtL133 `{BD 133} : LD 133 := {}.
+Instance BtR133 `{BD 133} : RD 133 := {}.
+Instance LtR133 `{LD 133} : TD 133 := {}.
+Instance RtR133 `{RD 133} : TD 133 := {}.
+Instance Ttb133 `{TD 133} : BD (S 133) := {}.
+
+Instance BtL134 `{BD 134} : LD 134 := {}.
+Instance BtR134 `{BD 134} : RD 134 := {}.
+Instance LtR134 `{LD 134} : TD 134 := {}.
+Instance RtR134 `{RD 134} : TD 134 := {}.
+Instance Ttb134 `{TD 134} : BD (S 134) := {}.
+
+Instance BtL135 `{BD 135} : LD 135 := {}.
+Instance BtR135 `{BD 135} : RD 135 := {}.
+Instance LtR135 `{LD 135} : TD 135 := {}.
+Instance RtR135 `{RD 135} : TD 135 := {}.
+Instance Ttb135 `{TD 135} : BD (S 135) := {}.
+
+Instance BtL136 `{BD 136} : LD 136 := {}.
+Instance BtR136 `{BD 136} : RD 136 := {}.
+Instance LtR136 `{LD 136} : TD 136 := {}.
+Instance RtR136 `{RD 136} : TD 136 := {}.
+Instance Ttb136 `{TD 136} : BD (S 136) := {}.
+
+Instance BtL137 `{BD 137} : LD 137 := {}.
+Instance BtR137 `{BD 137} : RD 137 := {}.
+Instance LtR137 `{LD 137} : TD 137 := {}.
+Instance RtR137 `{RD 137} : TD 137 := {}.
+Instance Ttb137 `{TD 137} : BD (S 137) := {}.
+
+Instance BtL138 `{BD 138} : LD 138 := {}.
+Instance BtR138 `{BD 138} : RD 138 := {}.
+Instance LtR138 `{LD 138} : TD 138 := {}.
+Instance RtR138 `{RD 138} : TD 138 := {}.
+Instance Ttb138 `{TD 138} : BD (S 138) := {}.
+
+Instance BtL139 `{BD 139} : LD 139 := {}.
+Instance BtR139 `{BD 139} : RD 139 := {}.
+Instance LtR139 `{LD 139} : TD 139 := {}.
+Instance RtR139 `{RD 139} : TD 139 := {}.
+Instance Ttb139 `{TD 139} : BD (S 139) := {}.
+
+Instance BtL140 `{BD 140} : LD 140 := {}.
+Instance BtR140 `{BD 140} : RD 140 := {}.
+Instance LtR140 `{LD 140} : TD 140 := {}.
+Instance RtR140 `{RD 140} : TD 140 := {}.
+Instance Ttb140 `{TD 140} : BD (S 140) := {}.
+
+Instance BtL141 `{BD 141} : LD 141 := {}.
+Instance BtR141 `{BD 141} : RD 141 := {}.
+Instance LtR141 `{LD 141} : TD 141 := {}.
+Instance RtR141 `{RD 141} : TD 141 := {}.
+Instance Ttb141 `{TD 141} : BD (S 141) := {}.
+
+Instance BtL142 `{BD 142} : LD 142 := {}.
+Instance BtR142 `{BD 142} : RD 142 := {}.
+Instance LtR142 `{LD 142} : TD 142 := {}.
+Instance RtR142 `{RD 142} : TD 142 := {}.
+Instance Ttb142 `{TD 142} : BD (S 142) := {}.
+
+Instance BtL143 `{BD 143} : LD 143 := {}.
+Instance BtR143 `{BD 143} : RD 143 := {}.
+Instance LtR143 `{LD 143} : TD 143 := {}.
+Instance RtR143 `{RD 143} : TD 143 := {}.
+Instance Ttb143 `{TD 143} : BD (S 143) := {}.
+
+Instance BtL144 `{BD 144} : LD 144 := {}.
+Instance BtR144 `{BD 144} : RD 144 := {}.
+Instance LtR144 `{LD 144} : TD 144 := {}.
+Instance RtR144 `{RD 144} : TD 144 := {}.
+Instance Ttb144 `{TD 144} : BD (S 144) := {}.
+
+Instance BtL145 `{BD 145} : LD 145 := {}.
+Instance BtR145 `{BD 145} : RD 145 := {}.
+Instance LtR145 `{LD 145} : TD 145 := {}.
+Instance RtR145 `{RD 145} : TD 145 := {}.
+Instance Ttb145 `{TD 145} : BD (S 145) := {}.
+
+Instance BtL146 `{BD 146} : LD 146 := {}.
+Instance BtR146 `{BD 146} : RD 146 := {}.
+Instance LtR146 `{LD 146} : TD 146 := {}.
+Instance RtR146 `{RD 146} : TD 146 := {}.
+Instance Ttb146 `{TD 146} : BD (S 146) := {}.
+
+Instance BtL147 `{BD 147} : LD 147 := {}.
+Instance BtR147 `{BD 147} : RD 147 := {}.
+Instance LtR147 `{LD 147} : TD 147 := {}.
+Instance RtR147 `{RD 147} : TD 147 := {}.
+Instance Ttb147 `{TD 147} : BD (S 147) := {}.
+
+Instance BtL148 `{BD 148} : LD 148 := {}.
+Instance BtR148 `{BD 148} : RD 148 := {}.
+Instance LtR148 `{LD 148} : TD 148 := {}.
+Instance RtR148 `{RD 148} : TD 148 := {}.
+Instance Ttb148 `{TD 148} : BD (S 148) := {}.
+
+Instance BtL149 `{BD 149} : LD 149 := {}.
+Instance BtR149 `{BD 149} : RD 149 := {}.
+Instance LtR149 `{LD 149} : TD 149 := {}.
+Instance RtR149 `{RD 149} : TD 149 := {}.
+Instance Ttb149 `{TD 149} : BD (S 149) := {}.
+
+Instance BtL150 `{BD 150} : LD 150 := {}.
+Instance BtR150 `{BD 150} : RD 150 := {}.
+Instance LtR150 `{LD 150} : TD 150 := {}.
+Instance RtR150 `{RD 150} : TD 150 := {}.
+Instance Ttb150 `{TD 150} : BD (S 150) := {}.
+
+Instance BtL151 `{BD 151} : LD 151 := {}.
+Instance BtR151 `{BD 151} : RD 151 := {}.
+Instance LtR151 `{LD 151} : TD 151 := {}.
+Instance RtR151 `{RD 151} : TD 151 := {}.
+Instance Ttb151 `{TD 151} : BD (S 151) := {}.
+
+Instance BtL152 `{BD 152} : LD 152 := {}.
+Instance BtR152 `{BD 152} : RD 152 := {}.
+Instance LtR152 `{LD 152} : TD 152 := {}.
+Instance RtR152 `{RD 152} : TD 152 := {}.
+Instance Ttb152 `{TD 152} : BD (S 152) := {}.
+
+Instance BtL153 `{BD 153} : LD 153 := {}.
+Instance BtR153 `{BD 153} : RD 153 := {}.
+Instance LtR153 `{LD 153} : TD 153 := {}.
+Instance RtR153 `{RD 153} : TD 153 := {}.
+Instance Ttb153 `{TD 153} : BD (S 153) := {}.
+
+Instance BtL154 `{BD 154} : LD 154 := {}.
+Instance BtR154 `{BD 154} : RD 154 := {}.
+Instance LtR154 `{LD 154} : TD 154 := {}.
+Instance RtR154 `{RD 154} : TD 154 := {}.
+Instance Ttb154 `{TD 154} : BD (S 154) := {}.
+
+Instance BtL155 `{BD 155} : LD 155 := {}.
+Instance BtR155 `{BD 155} : RD 155 := {}.
+Instance LtR155 `{LD 155} : TD 155 := {}.
+Instance RtR155 `{RD 155} : TD 155 := {}.
+Instance Ttb155 `{TD 155} : BD (S 155) := {}.
+
+Instance BtL156 `{BD 156} : LD 156 := {}.
+Instance BtR156 `{BD 156} : RD 156 := {}.
+Instance LtR156 `{LD 156} : TD 156 := {}.
+Instance RtR156 `{RD 156} : TD 156 := {}.
+Instance Ttb156 `{TD 156} : BD (S 156) := {}.
+
+Instance BtL157 `{BD 157} : LD 157 := {}.
+Instance BtR157 `{BD 157} : RD 157 := {}.
+Instance LtR157 `{LD 157} : TD 157 := {}.
+Instance RtR157 `{RD 157} : TD 157 := {}.
+Instance Ttb157 `{TD 157} : BD (S 157) := {}.
+
+Instance BtL158 `{BD 158} : LD 158 := {}.
+Instance BtR158 `{BD 158} : RD 158 := {}.
+Instance LtR158 `{LD 158} : TD 158 := {}.
+Instance RtR158 `{RD 158} : TD 158 := {}.
+Instance Ttb158 `{TD 158} : BD (S 158) := {}.
+
+Instance BtL159 `{BD 159} : LD 159 := {}.
+Instance BtR159 `{BD 159} : RD 159 := {}.
+Instance LtR159 `{LD 159} : TD 159 := {}.
+Instance RtR159 `{RD 159} : TD 159 := {}.
+Instance Ttb159 `{TD 159} : BD (S 159) := {}.
+
+Instance BtL160 `{BD 160} : LD 160 := {}.
+Instance BtR160 `{BD 160} : RD 160 := {}.
+Instance LtR160 `{LD 160} : TD 160 := {}.
+Instance RtR160 `{RD 160} : TD 160 := {}.
+Instance Ttb160 `{TD 160} : BD (S 160) := {}.
+
+Instance BtL161 `{BD 161} : LD 161 := {}.
+Instance BtR161 `{BD 161} : RD 161 := {}.
+Instance LtR161 `{LD 161} : TD 161 := {}.
+Instance RtR161 `{RD 161} : TD 161 := {}.
+Instance Ttb161 `{TD 161} : BD (S 161) := {}.
+
+Instance BtL162 `{BD 162} : LD 162 := {}.
+Instance BtR162 `{BD 162} : RD 162 := {}.
+Instance LtR162 `{LD 162} : TD 162 := {}.
+Instance RtR162 `{RD 162} : TD 162 := {}.
+Instance Ttb162 `{TD 162} : BD (S 162) := {}.
+
+Instance BtL163 `{BD 163} : LD 163 := {}.
+Instance BtR163 `{BD 163} : RD 163 := {}.
+Instance LtR163 `{LD 163} : TD 163 := {}.
+Instance RtR163 `{RD 163} : TD 163 := {}.
+Instance Ttb163 `{TD 163} : BD (S 163) := {}.
+
+Instance BtL164 `{BD 164} : LD 164 := {}.
+Instance BtR164 `{BD 164} : RD 164 := {}.
+Instance LtR164 `{LD 164} : TD 164 := {}.
+Instance RtR164 `{RD 164} : TD 164 := {}.
+Instance Ttb164 `{TD 164} : BD (S 164) := {}.
+
+Instance BtL165 `{BD 165} : LD 165 := {}.
+Instance BtR165 `{BD 165} : RD 165 := {}.
+Instance LtR165 `{LD 165} : TD 165 := {}.
+Instance RtR165 `{RD 165} : TD 165 := {}.
+Instance Ttb165 `{TD 165} : BD (S 165) := {}.
+
+Instance BtL166 `{BD 166} : LD 166 := {}.
+Instance BtR166 `{BD 166} : RD 166 := {}.
+Instance LtR166 `{LD 166} : TD 166 := {}.
+Instance RtR166 `{RD 166} : TD 166 := {}.
+Instance Ttb166 `{TD 166} : BD (S 166) := {}.
+
+Instance BtL167 `{BD 167} : LD 167 := {}.
+Instance BtR167 `{BD 167} : RD 167 := {}.
+Instance LtR167 `{LD 167} : TD 167 := {}.
+Instance RtR167 `{RD 167} : TD 167 := {}.
+Instance Ttb167 `{TD 167} : BD (S 167) := {}.
+
+Instance BtL168 `{BD 168} : LD 168 := {}.
+Instance BtR168 `{BD 168} : RD 168 := {}.
+Instance LtR168 `{LD 168} : TD 168 := {}.
+Instance RtR168 `{RD 168} : TD 168 := {}.
+Instance Ttb168 `{TD 168} : BD (S 168) := {}.
+
+Instance BtL169 `{BD 169} : LD 169 := {}.
+Instance BtR169 `{BD 169} : RD 169 := {}.
+Instance LtR169 `{LD 169} : TD 169 := {}.
+Instance RtR169 `{RD 169} : TD 169 := {}.
+Instance Ttb169 `{TD 169} : BD (S 169) := {}.
+
+Instance BtL170 `{BD 170} : LD 170 := {}.
+Instance BtR170 `{BD 170} : RD 170 := {}.
+Instance LtR170 `{LD 170} : TD 170 := {}.
+Instance RtR170 `{RD 170} : TD 170 := {}.
+Instance Ttb170 `{TD 170} : BD (S 170) := {}.
+
+Instance BtL171 `{BD 171} : LD 171 := {}.
+Instance BtR171 `{BD 171} : RD 171 := {}.
+Instance LtR171 `{LD 171} : TD 171 := {}.
+Instance RtR171 `{RD 171} : TD 171 := {}.
+Instance Ttb171 `{TD 171} : BD (S 171) := {}.
+
+Instance BtL172 `{BD 172} : LD 172 := {}.
+Instance BtR172 `{BD 172} : RD 172 := {}.
+Instance LtR172 `{LD 172} : TD 172 := {}.
+Instance RtR172 `{RD 172} : TD 172 := {}.
+Instance Ttb172 `{TD 172} : BD (S 172) := {}.
+
+Instance BtL173 `{BD 173} : LD 173 := {}.
+Instance BtR173 `{BD 173} : RD 173 := {}.
+Instance LtR173 `{LD 173} : TD 173 := {}.
+Instance RtR173 `{RD 173} : TD 173 := {}.
+Instance Ttb173 `{TD 173} : BD (S 173) := {}.
+
+Instance BtL174 `{BD 174} : LD 174 := {}.
+Instance BtR174 `{BD 174} : RD 174 := {}.
+Instance LtR174 `{LD 174} : TD 174 := {}.
+Instance RtR174 `{RD 174} : TD 174 := {}.
+Instance Ttb174 `{TD 174} : BD (S 174) := {}.
+
+Instance BtL175 `{BD 175} : LD 175 := {}.
+Instance BtR175 `{BD 175} : RD 175 := {}.
+Instance LtR175 `{LD 175} : TD 175 := {}.
+Instance RtR175 `{RD 175} : TD 175 := {}.
+Instance Ttb175 `{TD 175} : BD (S 175) := {}.
+
+Instance BtL176 `{BD 176} : LD 176 := {}.
+Instance BtR176 `{BD 176} : RD 176 := {}.
+Instance LtR176 `{LD 176} : TD 176 := {}.
+Instance RtR176 `{RD 176} : TD 176 := {}.
+Instance Ttb176 `{TD 176} : BD (S 176) := {}.
+
+Instance BtL177 `{BD 177} : LD 177 := {}.
+Instance BtR177 `{BD 177} : RD 177 := {}.
+Instance LtR177 `{LD 177} : TD 177 := {}.
+Instance RtR177 `{RD 177} : TD 177 := {}.
+Instance Ttb177 `{TD 177} : BD (S 177) := {}.
+
+Instance BtL178 `{BD 178} : LD 178 := {}.
+Instance BtR178 `{BD 178} : RD 178 := {}.
+Instance LtR178 `{LD 178} : TD 178 := {}.
+Instance RtR178 `{RD 178} : TD 178 := {}.
+Instance Ttb178 `{TD 178} : BD (S 178) := {}.
+
+Instance BtL179 `{BD 179} : LD 179 := {}.
+Instance BtR179 `{BD 179} : RD 179 := {}.
+Instance LtR179 `{LD 179} : TD 179 := {}.
+Instance RtR179 `{RD 179} : TD 179 := {}.
+Instance Ttb179 `{TD 179} : BD (S 179) := {}.
+
+Instance BtL180 `{BD 180} : LD 180 := {}.
+Instance BtR180 `{BD 180} : RD 180 := {}.
+Instance LtR180 `{LD 180} : TD 180 := {}.
+Instance RtR180 `{RD 180} : TD 180 := {}.
+Instance Ttb180 `{TD 180} : BD (S 180) := {}.
+
+Instance BtL181 `{BD 181} : LD 181 := {}.
+Instance BtR181 `{BD 181} : RD 181 := {}.
+Instance LtR181 `{LD 181} : TD 181 := {}.
+Instance RtR181 `{RD 181} : TD 181 := {}.
+Instance Ttb181 `{TD 181} : BD (S 181) := {}.
+
+Instance BtL182 `{BD 182} : LD 182 := {}.
+Instance BtR182 `{BD 182} : RD 182 := {}.
+Instance LtR182 `{LD 182} : TD 182 := {}.
+Instance RtR182 `{RD 182} : TD 182 := {}.
+Instance Ttb182 `{TD 182} : BD (S 182) := {}.
+
+Instance BtL183 `{BD 183} : LD 183 := {}.
+Instance BtR183 `{BD 183} : RD 183 := {}.
+Instance LtR183 `{LD 183} : TD 183 := {}.
+Instance RtR183 `{RD 183} : TD 183 := {}.
+Instance Ttb183 `{TD 183} : BD (S 183) := {}.
+
+Instance BtL184 `{BD 184} : LD 184 := {}.
+Instance BtR184 `{BD 184} : RD 184 := {}.
+Instance LtR184 `{LD 184} : TD 184 := {}.
+Instance RtR184 `{RD 184} : TD 184 := {}.
+Instance Ttb184 `{TD 184} : BD (S 184) := {}.
+
+Instance BtL185 `{BD 185} : LD 185 := {}.
+Instance BtR185 `{BD 185} : RD 185 := {}.
+Instance LtR185 `{LD 185} : TD 185 := {}.
+Instance RtR185 `{RD 185} : TD 185 := {}.
+Instance Ttb185 `{TD 185} : BD (S 185) := {}.
+
+Instance BtL186 `{BD 186} : LD 186 := {}.
+Instance BtR186 `{BD 186} : RD 186 := {}.
+Instance LtR186 `{LD 186} : TD 186 := {}.
+Instance RtR186 `{RD 186} : TD 186 := {}.
+Instance Ttb186 `{TD 186} : BD (S 186) := {}.
+
+Instance BtL187 `{BD 187} : LD 187 := {}.
+Instance BtR187 `{BD 187} : RD 187 := {}.
+Instance LtR187 `{LD 187} : TD 187 := {}.
+Instance RtR187 `{RD 187} : TD 187 := {}.
+Instance Ttb187 `{TD 187} : BD (S 187) := {}.
+
+Instance BtL188 `{BD 188} : LD 188 := {}.
+Instance BtR188 `{BD 188} : RD 188 := {}.
+Instance LtR188 `{LD 188} : TD 188 := {}.
+Instance RtR188 `{RD 188} : TD 188 := {}.
+Instance Ttb188 `{TD 188} : BD (S 188) := {}.
+
+Instance BtL189 `{BD 189} : LD 189 := {}.
+Instance BtR189 `{BD 189} : RD 189 := {}.
+Instance LtR189 `{LD 189} : TD 189 := {}.
+Instance RtR189 `{RD 189} : TD 189 := {}.
+Instance Ttb189 `{TD 189} : BD (S 189) := {}.
+
+Instance BtL190 `{BD 190} : LD 190 := {}.
+Instance BtR190 `{BD 190} : RD 190 := {}.
+Instance LtR190 `{LD 190} : TD 190 := {}.
+Instance RtR190 `{RD 190} : TD 190 := {}.
+Instance Ttb190 `{TD 190} : BD (S 190) := {}.
+
+Instance BtL191 `{BD 191} : LD 191 := {}.
+Instance BtR191 `{BD 191} : RD 191 := {}.
+Instance LtR191 `{LD 191} : TD 191 := {}.
+Instance RtR191 `{RD 191} : TD 191 := {}.
+Instance Ttb191 `{TD 191} : BD (S 191) := {}.
+
+Instance BtL192 `{BD 192} : LD 192 := {}.
+Instance BtR192 `{BD 192} : RD 192 := {}.
+Instance LtR192 `{LD 192} : TD 192 := {}.
+Instance RtR192 `{RD 192} : TD 192 := {}.
+Instance Ttb192 `{TD 192} : BD (S 192) := {}.
+
+Instance BtL193 `{BD 193} : LD 193 := {}.
+Instance BtR193 `{BD 193} : RD 193 := {}.
+Instance LtR193 `{LD 193} : TD 193 := {}.
+Instance RtR193 `{RD 193} : TD 193 := {}.
+Instance Ttb193 `{TD 193} : BD (S 193) := {}.
+
+Instance BtL194 `{BD 194} : LD 194 := {}.
+Instance BtR194 `{BD 194} : RD 194 := {}.
+Instance LtR194 `{LD 194} : TD 194 := {}.
+Instance RtR194 `{RD 194} : TD 194 := {}.
+Instance Ttb194 `{TD 194} : BD (S 194) := {}.
+
+Instance BtL195 `{BD 195} : LD 195 := {}.
+Instance BtR195 `{BD 195} : RD 195 := {}.
+Instance LtR195 `{LD 195} : TD 195 := {}.
+Instance RtR195 `{RD 195} : TD 195 := {}.
+Instance Ttb195 `{TD 195} : BD (S 195) := {}.
+
+Instance BtL196 `{BD 196} : LD 196 := {}.
+Instance BtR196 `{BD 196} : RD 196 := {}.
+Instance LtR196 `{LD 196} : TD 196 := {}.
+Instance RtR196 `{RD 196} : TD 196 := {}.
+Instance Ttb196 `{TD 196} : BD (S 196) := {}.
+
+Instance BtL197 `{BD 197} : LD 197 := {}.
+Instance BtR197 `{BD 197} : RD 197 := {}.
+Instance LtR197 `{LD 197} : TD 197 := {}.
+Instance RtR197 `{RD 197} : TD 197 := {}.
+Instance Ttb197 `{TD 197} : BD (S 197) := {}.
+
+Instance BtL198 `{BD 198} : LD 198 := {}.
+Instance BtR198 `{BD 198} : RD 198 := {}.
+Instance LtR198 `{LD 198} : TD 198 := {}.
+Instance RtR198 `{RD 198} : TD 198 := {}.
+Instance Ttb198 `{TD 198} : BD (S 198) := {}.
+
+Instance BtL199 `{BD 199} : LD 199 := {}.
+Instance BtR199 `{BD 199} : RD 199 := {}.
+Instance LtR199 `{LD 199} : TD 199 := {}.
+Instance RtR199 `{RD 199} : TD 199 := {}.
+Instance Ttb199 `{TD 199} : BD (S 199) := {}.
+
+(* Time Instance TestBD11 : BD 11 := _. *)
+(* Time Instance TestBD101 : BD 101 := _. *)
+Time Instance TestBD200 : BD 200 := _.

From 25019b77cb47d28a35660274df0438986b4ce428 Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Mon, 11 Aug 2025 15:52:59 +0200
Subject: [PATCH 09/23] Working tabled type class

---
 apps/tc-tabled/theories/tabled_type_class.v | 271 ++++++++------------
 1 file changed, 100 insertions(+), 171 deletions(-)

diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index b3fa5a30a..1f5655d88 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -48,17 +48,16 @@ Elpi Accumulate lp:{{
 
 Elpi Accumulate lp:{{
   pred type_equal i:ty i:ty o:cmp.
-  type_equal X Y eq :- var X, var Y.
-  type_equal (app L) (app G) Cmp :- type_equal_list L G Cmp.
-  type_equal X Y lt :- var X, ground_term Y.
-  type_equal X Y gt :- ground_term X, var Y.
   type_equal X Y Cmp :-
     ground_term X,
     ground_term Y,
     cmp_term X Y Cmp.
+  type_equal X Y eq :- var X, var Y.
+  type_equal (app L) (app G) Cmp :- type_equal_list L G Cmp.
+  type_equal X Y lt :- var X, ground_term Y.
+  type_equal X Y gt :- ground_term X, var Y.
 
   pred type_equal_list i:list ty i:list ty o:cmp.
-/* std.map L (x\ y\ type_equal x y eq) G. */
   type_equal_list [ X | XS ] [ Y | YS ] Cmp :-
       type_equal X Y eq,
       type_equal_list XS YS Cmp.
@@ -70,7 +69,10 @@ Elpi Accumulate lp:{{
 
   pred assertion_equal i:assertion i:assertion o:cmp.
   assertion_equal (assertion A _) (assertion B _) Cmp :-
-    type_equal A B Cmp.
+    type_equal A B Cmp,
+    !
+    /* Deterministic ! */
+    .
 
   pred term_typeclass i:term o:gref.
   term_typeclass (global Name) Name.
@@ -82,7 +84,6 @@ Elpi Accumulate lp:{{
   assertion_typeclass (assertion G _) Name :- term_typeclass G Name.
 }}.
 
-
 Elpi Accumulate lp:{{
   pred new_subgoal i:synth i:assertion i:waiter o:synth.
   new_subgoal
@@ -141,6 +142,7 @@ Elpi Accumulate lp:{{
     replace_var_term VA VB ITemp IB.
 }}.
 
+
 Elpi Accumulate lp:{{
   pred replace_list i:list term i:term i:term o:list term.
   replace_list [ A | XS ] A B [ B | YS ] :-
@@ -201,7 +203,6 @@ Elpi Accumulate lp:{{
   re_generalize [ ] [].
 }}.
 
-
 Elpi Accumulate lp:{{
   pred tc_instance_to_term i:tc-instance o:term.
   tc_instance_to_term (tc-instance (const C) _) T :-
@@ -210,6 +211,9 @@ Elpi Accumulate lp:{{
     T = Type.
 
   pred does_type_resolve i:term o:term.
+  does_type_resolve X Y :-
+    var Y,
+    X = Y.
   does_type_resolve X Y :-
     var X.
   does_type_resolve (app L) (app G) :-
@@ -220,19 +224,13 @@ Elpi Accumulate lp:{{
 
   pred try_resolve_types i:term i:term o:list term o:list assertion.
   try_resolve_types A (prod X T F) OL L :-
-    !,
     coq.typecheck V T ok,
     try_resolve_types A (F V) OLS LS,
     (OL = [ V | OLS]),
     ((T = app _ ; L = [ assertion T V | LS ]) ; (L = LS)) /* TODO : better 'contains instance or var test' */
     .
   try_resolve_types A B [] [] :-
-    /* @holes! ==> coq.unify-leq B A ok */
     does_type_resolve A B
-    /* type_equal A B lt */
-    /* cmp_term A B eq */
-    /* @holes! ==> pattern_match A B */
-    /* @holes! ==> coq.unify-leq B A ok */
     .
 }}.
 
@@ -264,7 +262,7 @@ Elpi Accumulate lp:{{
     try_resolve_types A B OL L,
     filter_metavariables L RL,
     !,
-    RT = A, /* app [ B | OL ], */
+    RT = A,
     ((OL = [], RV = BITm) ; RV = app [ BITm | OL ])
     .
 }}.
@@ -286,20 +284,19 @@ Elpi Accumulate lp:{{
     /* for each solution to g, push new cnode onto resume stack with it */
     std.map.find Goal AssertionTable (entry Waiters Answers),
     /* add new cnode to g's dependents */
-    /* TODO: Add answer here! */
     NewAnswers = [ Answer | Answers ],
     /* for each solution to g, push new cnode onto resume stack with it */
     std.fold Waiters (pr ResumeStack RootAnswer) (waiter_fun Answer Goal) (pr NewResumeStack NewRootAnswer),
     /* add new cnode to g's dependents */
-    std.map.remove Goal AssertionTable TempAssertionTable,
-    std.map.add Goal (entry Waiters NewAnswers) TempAssertionTable NewAssertionTable /* TODO: [] or Waiters? */.
+    /* std.map.remove Goal AssertionTable TempAssertionTable, */
+    std.map.add Goal (entry Waiters NewAnswers) AssertionTable NewAssertionTable,
+    !.
 
   new_consumer_node
       (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
       _
-      CN
+      (consumer_node _ [ Subgoal | _ ] as CN)
       (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer) :-
-      CN = consumer_node _ [ Subgoal | _ ],
       /* TODO: Consumer node is general instead of variable or hole */
       if (std.map.find Subgoal AssertionTable (entry Waiters Answers))
          (
@@ -319,7 +316,8 @@ Elpi Accumulate lp:{{
             Subgoal
             (callback CN)
             (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer)
-        ).
+        ),
+        !.
 
     new_consumer_node _ _ _ _ :- coq.error "Failed new consumer node!" , fail.
 }}.
@@ -336,8 +334,7 @@ Elpi Accumulate lp:{{
     NewAnswer = assertion AnswerNT AnswerV,
     if (try_answer Subgoal NewAnswer Goal UpdatedGoal Remaining UpdatedRemaining)
        (
-       /* TODO: Update Remaining with unification from try_answer ! */
-       /* keep goal? clone? */
+        /* TODO: Update Remaining with unification from try_answer ! */
         new_consumer_node
          (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
          UpdatedGoal /* TODO: final answer here! */
@@ -358,17 +355,18 @@ Elpi Accumulate lp:{{
     (synth [ generator_node Goal [Instance | Instances ] | GeneratorStack ]
       ResumeStack AssertionTable RootAnswer) Query NewSynth FinalAnswer :-
     if (try_resolve Goal Instance Resolved Subgoals)
-        (
-        /* else (l. 14) */
-        (new_consumer_node
+       (
+         /* else (l. 14) */
+         new_consumer_node
           (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
-          Resolved /* TODO: does not follow protocol! dummy value? */
-          (consumer_node Resolved Subgoals) NewSynth)
-        )
-        (
-        /* If first subgoal of cnode does not resolve with solution then Continue */
-        NewSynth = (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
-      ).
+          Resolved
+          (consumer_node Resolved Subgoals) NewSynth
+       )
+       (
+         /* If first subgoal of cnode does not resolve with solution then Continue */
+         /* coq.say "Fall through", */
+         NewSynth = (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
+       ).
 
   tabled_typeclass_resolution_body
     (synth [ generator_node _ [] | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
@@ -385,7 +383,11 @@ Elpi Accumulate lp:{{
   synth_loop (synth _ _ _ (some Answer)) _ Fuel Answer.
   synth_loop MySynth Query Fuel FinalAnswer :-
     MySynth = synth Stack1 Stack2 _ _,
-    coq.say "synth round" Fuel Stack2 Stack1,
+    coq.say "synth round" Fuel,
+    ((Stack1 = [ generator_node (assertion (StkHd1T) (StkHd1V)) L1 | _ ] , coq.say "topG:" {coq.term->string StkHd1T} {coq.term->string StkHd1V} L1); true),
+    ((Stack2 = [ pr (consumer_node (assertion StkHd2T StkHd2V) _) (assertion AnsT AnsV) | _ ] , coq.say "topR:" {coq.term->string StkHd2T} {coq.term->string StkHd2V}, coq.say "answer:" {coq.term->string AnsT} {coq.term->string AnsV}); true),
+    coq.say "",
+    /* coq.say "synth round" Fuel Stack2 Stack1, */
     Fuel > 0,
     tabled_typeclass_resolution_body MySynth Query NextSynth FinalAnswer,
     !,
@@ -397,7 +399,7 @@ Elpi Accumulate lp:{{
     std.map.make assertion_equal AssertionTableEmpty,
     new_subgoal (synth [] [] AssertionTableEmpty none) Query root MySynth,
     /* while true do */
-    synth_loop MySynth Query 2000 FinalAnswer,
+    synth_loop MySynth Query 20000 FinalAnswer,
     !.
 }}.
 
@@ -433,6 +435,10 @@ Elpi Query lp:{{
   ground_term FinalAnswer.
 }}.
 
+(* https://github.com/leanprover/lean4/blob/cade21/src/Lean/Meta/SynthInstance.lean *)
+(* https://github.com/leanprover/lean4/blob/master/tests/lean/run/typeclass_diamond.lean *)
+(* Diamond *)
+
 (* https://github.com/LPCIC/coq-elpi/blob/master/builtin-doc/coq-builtin.elpi *)
 Elpi Accumulate lp:{{
   pred proof_search i:list gref i:list tc-instance i:term o:term.
@@ -453,15 +459,19 @@ Elpi Accumulate lp:{{
 Elpi Accumulate lp:{{
   pred tabled_proof_search i:list gref i:term o:term.
   tabled_proof_search Typeclasses Type PRoof :-
+    coq.say "TYPECLASSES" Typeclasses,
     MyGoal = assertion Type {{ _ }},
-    /* term_to_assertion Type none MyGoal, /* MyGoal is Assertion */ */
     tabled_typeclass_resolution MyGoal FinalAnswer,
     !,
+
+    /* Convert from result to proof term! */
+
     FinalAnswer = assertion FinalType FinalTerm,
     FinalProof = FinalTerm,
-    coq.say "FinalProof" FinalProof,
+    coq.say "FinalProof" {coq.term->string FinalProof},
     PRoof = FinalProof,
-    coq.say "Proof" PRoof "Done".
+    coq.say "Proof" {coq.term->string PRoof} "Done"
+    .
 
 
   pred search_context i:list prop i:term o:term.
@@ -474,7 +484,7 @@ Elpi Accumulate lp:{{
   solve (goal Ctx Trigger Type PRoof Args as G) V :-
     coq.TC.db-tc Typeclasses,
     coq.say "AGRS" Args Ctx,
-    coq.say "SEARCHING ..." Type, !,
+    coq.say "SEARCHING ..." {coq.term->string Type}, !,
     coq.say "V" V,
     (search_context Ctx Type PRoof ; tabled_proof_search Typeclasses Type PRoof),
     coq.say "SUCCESS FINDING INSTANCE".
@@ -528,135 +538,54 @@ Instance TestArgument : Argument unit := _.
 Instance AArg (alpha : Type) : Argument alpha := {}.
 Instance TestArgumentArg : Argument nat := _.
 
-(* Direct Simple Diamond example *)
-Class TD (n : nat).
-Class RD (n : nat).
-Class LD (n : nat).
-Class BD (n : nat).
-
-Instance BD0 : BD 0 := {}.
-
-Instance BtL0 `{BD 0} : LD 0 := {}.
-Instance BtR0 `{BD 0} : RD 0 := {}.
-Instance LtR0 `{LD 0} : TD 0 := {}.
-Instance RtR0 `{RD 0} : TD 0 := {}.
-Instance Ttb0 `{TD 0} : BD (S 0) := {}.
-
-Instance BtL1 `{BD 1} : LD 1 := {}.
-Instance BtR1 `{BD 1} : RD 1 := {}.
-Instance LtR1 `{LD 1} : TD 1 := {}.
-Instance RtR1 `{RD 1} : TD 1 := {}.
-Instance Ttb1 `{TD 1} : BD (S 1) := {}.
-
-Instance BtL2 `{BD 2} : LD 2 := {}.
-Instance BtR2 `{BD 2} : RD 2 := {}.
-Instance LtR2 `{LD 2} : TD 2 := {}.
-Instance RtR2 `{RD 2} : TD 2 := {}.
-Instance Ttb2 `{TD 2} : BD (S 2) := {}.
-
-Instance BtL3 `{BD 3} : LD 3 := {}.
-Instance BtR3 `{BD 3} : RD 3 := {}.
-Instance LtR3 `{LD 3} : TD 3 := {}.
-Instance RtR3 `{RD 3} : TD 3 := {}.
-Instance Ttb3 `{TD 3} : BD (S 3) := {}.
-
-Instance BtL4 `{BD 4} : LD 4 := {}.
-Instance BtR4 `{BD 4} : RD 4 := {}.
-Instance LtR4 `{LD 4} : TD 4 := {}.
-Instance RtR4 `{RD 4} : TD 4 := {}.
-Instance Ttb4 `{TD 4} : BD (S 4) := {}.
-
-Instance BtL5 `{BD 5} : LD 5 := {}.
-Instance BtR5 `{BD 5} : RD 5 := {}.
-Instance LtR5 `{LD 5} : TD 5 := {}.
-Instance RtR5 `{RD 5} : TD 5 := {}.
-Instance Ttb5 `{TD 5} : BD (S 5) := {}.
-
-Instance BtL6 `{BD 6} : LD 6 := {}.
-Instance BtR6 `{BD 6} : RD 6 := {}.
-Instance LtR6 `{LD 6} : TD 6 := {}.
-Instance RtR6 `{RD 6} : TD 6 := {}.
-Instance Ttb6 `{TD 6} : BD (S 6) := {}.
-
-Instance BtL7 `{BD 7} : LD 7 := {}.
-Instance BtR7 `{BD 7} : RD 7 := {}.
-Instance LtR7 `{LD 7} : TD 7 := {}.
-Instance RtR7 `{RD 7} : TD 7 := {}.
-Instance Ttb7 `{TD 7} : BD (S 7) := {}.
-
-Instance BtL8 `{BD 8} : LD 8 := {}.
-Instance BtR8 `{BD 8} : RD 8 := {}.
-Instance LtR8 `{LD 8} : TD 8 := {}.
-Instance RtR8 `{RD 8} : TD 8 := {}.
-Instance Ttb8 `{TD 8} : BD (S 8) := {}.
-
-Instance BtL9 `{BD 9} : LD 9 := {}.
-Instance BtR9 `{BD 9} : RD 9 := {}.
-Instance LtR9 `{LD 9} : TD 9 := {}.
-Instance RtR9 `{RD 9} : TD 9 := {}.
-Instance Ttb9 `{TD 9} : BD (S 9) := {}.
-
-Instance BtL10 `{BD 10} : LD 10 := {}.
-Instance BtR10 `{BD 10} : RD 10 := {}.
-Instance LtR10 `{LD 10} : TD 10 := {}.
-Instance RtR10 `{RD 10} : TD 10 := {}.
-Instance Ttb10 `{TD 10} : BD (S 10) := {}.
-
-Instance BtL11 `{BD 11} : LD 11 := {}.
-Instance BtR11 `{BD 11} : RD 11 := {}.
-Instance LtR11 `{LD 11} : TD 11 := {}.
-Instance RtR11 `{RD 11} : TD 11 := {}.
-Instance Ttb11 `{TD 11} : BD (S 11) := {}.
-
-Instance TestTD10 : TD 11 := _.
-
-(* (* Partial Simple Diamond example *) *)
-(* Class T (n : nat). *)
-(* Class R (n : nat). *)
-(* Class L (n : nat). *)
-(* Class B (n : nat). *)
-(* Instance BtL n `{B n} : L n := {}. *)
-(* Instance BtR n `{B n} : R n := {}. *)
-(* Instance LtR n `{L n} : T n := {}. *)
-(* Instance RtR n `{R n} : T n := {}. *)
-(* Instance Ttb n `{T n} : B (S n) := {}. *)
-
-(* Instance B0 : B 0 := {}. *)
-
-(* Instance Test0 : B 0 := _. *)
-(* Instance Test1 : B 1 := _. *)
-(* Instance Test2 : B 2 := _. *)
-
-(* Instance Test10 : B 10 := _. *)
-
-(* Instance Test4 : B 4 := _. *)
-(* Instance Test100 : B 10 := _. *)
-
-(* (* Partial Diamond example *) *)
-(* Class T (alpha : Type) (n : nat). *)
-(* Class R (alpha : Type) (n : nat). *)
-(* Class L (alpha : Type) (n : nat). *)
-(* Class B (alpha : Type) (n : nat). *)
-(* Instance BtL alpha n `{B alpha n} : L alpha n := {}. *)
-(* Instance BtR alpha n `{B alpha n} : R alpha n := {}. *)
-(* Instance LtR alpha n `{L alpha n} : T alpha n := {}. *)
-(* Instance RtR alpha n `{R alpha n} : T alpha n := {}. *)
-
-(* Instance B0 alpha : B alpha 0 := {}. *)
-
-(* Instance Test0 : B unit 0 := _. *)
-
-(* (* Diamond example in Rocq *) *)
-(* Class T (alpha : Type) (n : nat). *)
-(* Class R (alpha : Type) (n : nat). *)
-(* Class L (alpha : Type) (n : nat). *)
-(* Class B (alpha : Type) (n : nat). *)
-(* Instance BtL alpha n `{B alpha n} : L alpha n := {}. *)
-(* Instance BtR alpha n `{B alpha n} : R alpha n := {}. *)
-(* Instance LtR alpha n `{L alpha n} : T alpha n := {}. *)
-(* Instance RtR alpha n `{R alpha n} : T alpha n := {}. *)
-(* Instance TtR alpha n `{T alpha n} : B alpha (S n) := {}. *)
-
-(* Instance B0 alpha : B alpha 0 := {}. *)
-
-(* Fail Instance TtR20 : B unit 20 := _. *)
+(* Partial Simple Diamond example *)
+Class T (n : nat).
+Class R (n : nat).
+Class L (n : nat).
+Class B (n : nat).
+Instance BtL n `{B n} : L n := {}.
+Instance BtR n `{B n} : R n := {}.
+Instance LtR n `{L n} : T n := {}.
+Instance RtR n `{R n} : T n := {}.
+Instance Ttb n `{T n} : B (S n) := {}.
+
+Instance B0 : B 0 := {}.
+
+(* Instance Test0 : B 0 := _.
+Instance Test1 : B 1 := _.
+Instance Test2 : B 2 := _.
+   Instance Test5 : B 5 := _. *)
+
+(* Set Printing Implicit. *)
+
+(* 0.096 secs *)
+(* Time Instance Test10 : B 10 := _. *)
+
+(* 0.413 secs *)
+(* Time Instance Test20 : B 20 := _. *)
+
+(* 88.014 secs *)
+(* Time Instance Test100 : B 100 := _. *)
+
+(* 1176.986 secs *)
+Time Instance Test200 : B 200 := _.
+
+(* Time Instance Test500 : B 500 := _. *)
+(* Time Instance Test1000 : B 1000 := _. *)
+
+(*
+(* Diamond example in Rocq *)
+Class T (alpha : Type) (n : nat).
+Class R (alpha : Type) (n : nat).
+Class L (alpha : Type) (n : nat).
+Class B (alpha : Type) (n : nat).
+Instance BtL alpha n `{B alpha n} : L alpha n := {}.
+Instance BtR alpha n `{B alpha n} : R alpha n := {}.
+Instance LtR alpha n `{L alpha n} : T alpha n := {}.
+Instance RtR alpha n `{R alpha n} : T alpha n := {}.
+Instance TtR alpha n `{T alpha n} : B alpha (S n) := {}.
+
+Instance B0 alpha : B alpha 0 := {}.
+
+Fail Instance TtR20 : B unit 20 := _.
+*)

From 5d3922cbaa82e8c909ec83d0695579b5ab7e958f Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Mon, 11 Aug 2025 16:10:37 +0200
Subject: [PATCH 10/23] Working diamond example

---
 apps/tc-tabled/theories/diamond.v           | 33 +++++++---
 apps/tc-tabled/theories/tabled_type_class.v | 70 ++-------------------
 2 files changed, 30 insertions(+), 73 deletions(-)

diff --git a/apps/tc-tabled/theories/diamond.v b/apps/tc-tabled/theories/diamond.v
index bb9e1ac68..943d76b77 100644
--- a/apps/tc-tabled/theories/diamond.v
+++ b/apps/tc-tabled/theories/diamond.v
@@ -11,20 +11,37 @@ Instance TtR alpha n `{T alpha n} : B alpha (S n) := {}.
 
 Instance B0 alpha : B alpha 0 := {}.
 
-(* Finished transaction in 0.004 secs (0.004u,0.s) (successful) *)
-Module Test20. Time Instance TtR20 : B unit 20 := _. End Test20.
+(* Rocq: Finished transaction in 0.151 secs (0.151u,0.s) (successful) *)
+Module Test100. Time Instance TtR100 : B unit 100 := _. End Test100.
 
-(* Finished transaction in 1.372 secs (1.195u,0.03s) (successful) *)
+(* Rocq: Finished transaction in 1.372 secs (1.195u,0.03s) (successful) *)
 Module Test200. Time Instance TtR200 : B unit 200 := _. End Test200.
 
-(* Finished transaction in 4.842 secs (4.084u,0.147s) (successful) *)
+(* Rocq: Finished transaction in 4.842 secs (4.084u,0.147s) (successful) *)
 Module Test300. Time Instance TtR300 : B unit 300 := _. End Test300.
 
-(* Finished transaction in 23.508 secs (22.228u,0.258s) (successful) *)
+(* Rocq: Finished transaction in 12.245 secs (11.568u,0.091s) (successful) *)
+Module Test400. Time Instance TtR400 : B unit 400 := _. End Test400.
+
+(* Rocq: Finished transaction in 23.508 secs (22.228u,0.258s) (successful) *)
 Module Test500. Time Instance TtR500 : B unit 500 := _. End Test500.
 
-(* Finished transaction in 31.622 secs (28.185u,0.517s) (successful) *)
-Module Test550. Time Instance TtR550 : B unit 550 := _. End Test550.
+(* Rocq: Finished transaction in 37.784 secs (37.582u,0.059s) (successful) *)
+Module Test600. Time Instance TtR600 : B unit 600 := _. End Test600.
+
+(* Rocq: Finished transaction in 66.476 secs (66.261u,0.106s) (successful) *)
+Module Test700. Time Instance TtR700 : B unit 700 := _. End Test700.
+
+(* Rocq: Finished transaction in 77.99 secs (77.174u,0.11s) (successful) *)
+Module Test800. Time Instance TtR800 : B unit 800 := _. End Test800.
 
-(* Finished transaction in 31.622 secs (28.185u,0.517s) (successful) *)
+(* Rocq: Finished transaction in 106.952 secs (106.779u,0.025s) (successful) *)
+Module Test900. Time Instance TtR900 : B unit 900 := _. End Test900.
+
+(* Rocq: Finished transaction in 184.144 secs (183.71u,0.117s) (successful) *)
 Module Test1000. Time Instance TtR1000 : B unit 1000 := _. End Test1000.
+
+(* Ratio: ~ time: 2^(x/100) secs *)
+
+(* Rocq: Finished transaction in 1476.371 secs (1463.871u,3.989s) (successful) *)
+Module Test2000. Time Instance TtR2000 : B unit 2000 := _. End Test2000.
diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index 1f5655d88..4002c5ce6 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -364,7 +364,6 @@ Elpi Accumulate lp:{{
        )
        (
          /* If first subgoal of cnode does not resolve with solution then Continue */
-         /* coq.say "Fall through", */
          NewSynth = (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
        ).
 
@@ -498,46 +497,6 @@ Elpi TC Solver Override TC.TabledSolver All.
 
 Elpi Export TC.TabledSolver.
 
-(* Trivial test *)
-Class Constant := {}.
-Instance Con : Constant := {}.
-
-(* Check holes *)
-Elpi Query lp:{{
-  /* {{ Instance TestConstant : Constant := _ }} */
-  coq.elaborate-skeleton {{ lib:elpi.hole }} {{ Constant }} V ok,
-  coq.say "Elaborates to" V.
-}}.
-Instance TestConstant : Constant := _.
-
-(* Test instance dependency *)
-Class Dependency := {}.
-
-Instance Dep `{Constant} : Dependency := {}.
-
-Elpi Query lp:{{
-  /* {{ Instance TestConstant : Constant := _ }} */
-  coq.elaborate-skeleton {{ lib:elpi.hole }} {{ Constant }} V ok,
-  coq.say "Elaborates to" V.
-}}.
-
-Elpi Query lp:{{
-  coq.say "Dep" {{ Constant }},
-  coq.elaborate-skeleton {{ lib:elpi.hole }} {{ Constant }} _ ok, !,
-  coq.elaborate-skeleton {{ lib:elpi.hole }} {{ Dependency }} V ok,
-  coq.say "Elaborates to" V.
-}}.
-
-(* Instance TestDependency : Dependency := _. *)
-
-(* Trivial test *)
-Class Argument (alpha : Type) := {}.
-Instance Arg : Argument unit := {}.
-Instance TestArgument : Argument unit := _.
-
-Instance AArg (alpha : Type) : Argument alpha := {}.
-Instance TestArgumentArg : Argument nat := _.
-
 (* Partial Simple Diamond example *)
 Class T (n : nat).
 Class R (n : nat).
@@ -551,12 +510,10 @@ Instance Ttb n `{T n} : B (S n) := {}.
 
 Instance B0 : B 0 := {}.
 
-(* Instance Test0 : B 0 := _.
-Instance Test1 : B 1 := _.
-Instance Test2 : B 2 := _.
-   Instance Test5 : B 5 := _. *)
-
-(* Set Printing Implicit. *)
+(* Instance Test0 : B 0 := _. *)
+(* Instance Test1 : B 1 := _. *)
+(* Instance Test2 : B 2 := _. *)
+(* Instance Test5 : B 5 := _. *)
 
 (* 0.096 secs *)
 (* Time Instance Test10 : B 10 := _. *)
@@ -568,24 +525,7 @@ Instance Test2 : B 2 := _.
 (* Time Instance Test100 : B 100 := _. *)
 
 (* 1176.986 secs *)
-Time Instance Test200 : B 200 := _.
+(* Time Instance Test200 : B 200 := _. *)
 
 (* Time Instance Test500 : B 500 := _. *)
 (* Time Instance Test1000 : B 1000 := _. *)
-
-(*
-(* Diamond example in Rocq *)
-Class T (alpha : Type) (n : nat).
-Class R (alpha : Type) (n : nat).
-Class L (alpha : Type) (n : nat).
-Class B (alpha : Type) (n : nat).
-Instance BtL alpha n `{B alpha n} : L alpha n := {}.
-Instance BtR alpha n `{B alpha n} : R alpha n := {}.
-Instance LtR alpha n `{L alpha n} : T alpha n := {}.
-Instance RtR alpha n `{R alpha n} : T alpha n := {}.
-Instance TtR alpha n `{T alpha n} : B alpha (S n) := {}.
-
-Instance B0 alpha : B alpha 0 := {}.
-
-Fail Instance TtR20 : B unit 20 := _.
-*)

From b201546a74063d50eddaae6b09f9f8254a0181d1 Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Mon, 11 Aug 2025 17:04:34 +0200
Subject: [PATCH 11/23] WIP - add tabled-type-class to dune

---
 apps/tc-tabled/elpi/dune                    |   20 +
 apps/tc-tabled/elpi/test.elpi               |    1 +
 apps/tc-tabled/theories/diamond.v           |    7 +
 apps/tc-tabled/theories/diamond_unfolded.v  | 1211 -------------------
 apps/tc-tabled/theories/dune                |    8 +
 apps/tc-tabled/theories/tabled_type_class.v |    4 +-
 6 files changed, 37 insertions(+), 1214 deletions(-)
 create mode 100644 apps/tc-tabled/elpi/dune
 create mode 100644 apps/tc-tabled/elpi/test.elpi
 delete mode 100644 apps/tc-tabled/theories/diamond_unfolded.v
 create mode 100644 apps/tc-tabled/theories/dune

diff --git a/apps/tc-tabled/elpi/dune b/apps/tc-tabled/elpi/dune
new file mode 100644
index 000000000..32ffac8ad
--- /dev/null
+++ b/apps/tc-tabled/elpi/dune
@@ -0,0 +1,20 @@
+(coq.theory
+ (name elpi.apps.tc_tabled.elpi)
+ (package rocq-elpi)
+ (theories elpi elpi.apps.tc elpi.apps.tc.elpi))
+
+(rule
+ (target dummy.v)
+ (deps
+  (glob_files *.elpi))
+ (action
+  (with-stdout-to %{target}
+   (progn
+     (run rocq_elpi_shafile %{deps})))))
+
+(install
+ (files
+  (glob_files (*.elpi with_prefix coq/user-contrib/elpi/apps/tc/elpi/))
+  (glob_files (*.elpi with_prefix coq/user-contrib/elpi/apps/tc-tabled/elpi/)))
+ (section lib_root)
+ (package rocq-elpi))
diff --git a/apps/tc-tabled/elpi/test.elpi b/apps/tc-tabled/elpi/test.elpi
new file mode 100644
index 000000000..8b1378917
--- /dev/null
+++ b/apps/tc-tabled/elpi/test.elpi
@@ -0,0 +1 @@
+
diff --git a/apps/tc-tabled/theories/diamond.v b/apps/tc-tabled/theories/diamond.v
index 943d76b77..9f6566d32 100644
--- a/apps/tc-tabled/theories/diamond.v
+++ b/apps/tc-tabled/theories/diamond.v
@@ -1,4 +1,11 @@
+From elpi.apps.tc_tabled Require Import tabled_type_class.
+
 (* Diamond example in Rocq *)
+Elpi TC Solver Activate TC.TabledSolver.
+Elpi TC Solver Override TC.TabledSolver All.
+
+Elpi Export TC.TabledSolver.
+
 Class T (alpha : Type) (n : nat).
 Class R (alpha : Type) (n : nat).
 Class L (alpha : Type) (n : nat).
diff --git a/apps/tc-tabled/theories/diamond_unfolded.v b/apps/tc-tabled/theories/diamond_unfolded.v
deleted file mode 100644
index f932a25a2..000000000
--- a/apps/tc-tabled/theories/diamond_unfolded.v
+++ /dev/null
@@ -1,1211 +0,0 @@
-(* Direct Simple Diamond example *)
-Class TD (n : nat).
-Class RD (n : nat).
-Class LD (n : nat).
-Class BD (n : nat).
-
-Instance BD0 : BD 0 := {}.
-
-Instance BtL0 `{BD 0} : LD 0 := {}.
-Instance BtR0 `{BD 0} : RD 0 := {}.
-Instance LtR0 `{LD 0} : TD 0 := {}.
-Instance RtR0 `{RD 0} : TD 0 := {}.
-Instance Ttb0 `{TD 0} : BD (S 0) := {}.
-
-Instance BtL1 `{BD 1} : LD 1 := {}.
-Instance BtR1 `{BD 1} : RD 1 := {}.
-Instance LtR1 `{LD 1} : TD 1 := {}.
-Instance RtR1 `{RD 1} : TD 1 := {}.
-Instance Ttb1 `{TD 1} : BD (S 1) := {}.
-
-Instance BtL2 `{BD 2} : LD 2 := {}.
-Instance BtR2 `{BD 2} : RD 2 := {}.
-Instance LtR2 `{LD 2} : TD 2 := {}.
-Instance RtR2 `{RD 2} : TD 2 := {}.
-Instance Ttb2 `{TD 2} : BD (S 2) := {}.
-
-Instance BtL3 `{BD 3} : LD 3 := {}.
-Instance BtR3 `{BD 3} : RD 3 := {}.
-Instance LtR3 `{LD 3} : TD 3 := {}.
-Instance RtR3 `{RD 3} : TD 3 := {}.
-Instance Ttb3 `{TD 3} : BD (S 3) := {}.
-
-Instance BtL4 `{BD 4} : LD 4 := {}.
-Instance BtR4 `{BD 4} : RD 4 := {}.
-Instance LtR4 `{LD 4} : TD 4 := {}.
-Instance RtR4 `{RD 4} : TD 4 := {}.
-Instance Ttb4 `{TD 4} : BD (S 4) := {}.
-
-Instance BtL5 `{BD 5} : LD 5 := {}.
-Instance BtR5 `{BD 5} : RD 5 := {}.
-Instance LtR5 `{LD 5} : TD 5 := {}.
-Instance RtR5 `{RD 5} : TD 5 := {}.
-Instance Ttb5 `{TD 5} : BD (S 5) := {}.
-
-Instance BtL6 `{BD 6} : LD 6 := {}.
-Instance BtR6 `{BD 6} : RD 6 := {}.
-Instance LtR6 `{LD 6} : TD 6 := {}.
-Instance RtR6 `{RD 6} : TD 6 := {}.
-Instance Ttb6 `{TD 6} : BD (S 6) := {}.
-
-Instance BtL7 `{BD 7} : LD 7 := {}.
-Instance BtR7 `{BD 7} : RD 7 := {}.
-Instance LtR7 `{LD 7} : TD 7 := {}.
-Instance RtR7 `{RD 7} : TD 7 := {}.
-Instance Ttb7 `{TD 7} : BD (S 7) := {}.
-
-Instance BtL8 `{BD 8} : LD 8 := {}.
-Instance BtR8 `{BD 8} : RD 8 := {}.
-Instance LtR8 `{LD 8} : TD 8 := {}.
-Instance RtR8 `{RD 8} : TD 8 := {}.
-Instance Ttb8 `{TD 8} : BD (S 8) := {}.
-
-Instance BtL9 `{BD 9} : LD 9 := {}.
-Instance BtR9 `{BD 9} : RD 9 := {}.
-Instance LtR9 `{LD 9} : TD 9 := {}.
-Instance RtR9 `{RD 9} : TD 9 := {}.
-Instance Ttb9 `{TD 9} : BD (S 9) := {}.
-
-Instance BtL10 `{BD 10} : LD 10 := {}.
-Instance BtR10 `{BD 10} : RD 10 := {}.
-Instance LtR10 `{LD 10} : TD 10 := {}.
-Instance RtR10 `{RD 10} : TD 10 := {}.
-Instance Ttb10 `{TD 10} : BD (S 10) := {}.
-
-Instance BtL11 `{BD 11} : LD 11 := {}.
-Instance BtR11 `{BD 11} : RD 11 := {}.
-Instance LtR11 `{LD 11} : TD 11 := {}.
-Instance RtR11 `{RD 11} : TD 11 := {}.
-Instance Ttb11 `{TD 11} : BD (S 11) := {}.
-
-Instance BtL12 `{BD 12} : LD 12 := {}.
-Instance BtR12 `{BD 12} : RD 12 := {}.
-Instance LtR12 `{LD 12} : TD 12 := {}.
-Instance RtR12 `{RD 12} : TD 12 := {}.
-Instance Ttb12 `{TD 12} : BD (S 12) := {}.
-
-Instance BtL13 `{BD 13} : LD 13 := {}.
-Instance BtR13 `{BD 13} : RD 13 := {}.
-Instance LtR13 `{LD 13} : TD 13 := {}.
-Instance RtR13 `{RD 13} : TD 13 := {}.
-Instance Ttb13 `{TD 13} : BD (S 13) := {}.
-
-Instance BtL14 `{BD 14} : LD 14 := {}.
-Instance BtR14 `{BD 14} : RD 14 := {}.
-Instance LtR14 `{LD 14} : TD 14 := {}.
-Instance RtR14 `{RD 14} : TD 14 := {}.
-Instance Ttb14 `{TD 14} : BD (S 14) := {}.
-
-Instance BtL15 `{BD 15} : LD 15 := {}.
-Instance BtR15 `{BD 15} : RD 15 := {}.
-Instance LtR15 `{LD 15} : TD 15 := {}.
-Instance RtR15 `{RD 15} : TD 15 := {}.
-Instance Ttb15 `{TD 15} : BD (S 15) := {}.
-
-Instance BtL16 `{BD 16} : LD 16 := {}.
-Instance BtR16 `{BD 16} : RD 16 := {}.
-Instance LtR16 `{LD 16} : TD 16 := {}.
-Instance RtR16 `{RD 16} : TD 16 := {}.
-Instance Ttb16 `{TD 16} : BD (S 16) := {}.
-
-Instance BtL17 `{BD 17} : LD 17 := {}.
-Instance BtR17 `{BD 17} : RD 17 := {}.
-Instance LtR17 `{LD 17} : TD 17 := {}.
-Instance RtR17 `{RD 17} : TD 17 := {}.
-Instance Ttb17 `{TD 17} : BD (S 17) := {}.
-
-Instance BtL18 `{BD 18} : LD 18 := {}.
-Instance BtR18 `{BD 18} : RD 18 := {}.
-Instance LtR18 `{LD 18} : TD 18 := {}.
-Instance RtR18 `{RD 18} : TD 18 := {}.
-Instance Ttb18 `{TD 18} : BD (S 18) := {}.
-
-Instance BtL19 `{BD 19} : LD 19 := {}.
-Instance BtR19 `{BD 19} : RD 19 := {}.
-Instance LtR19 `{LD 19} : TD 19 := {}.
-Instance RtR19 `{RD 19} : TD 19 := {}.
-Instance Ttb19 `{TD 19} : BD (S 19) := {}.
-
-Instance BtL20 `{BD 20} : LD 20 := {}.
-Instance BtR20 `{BD 20} : RD 20 := {}.
-Instance LtR20 `{LD 20} : TD 20 := {}.
-Instance RtR20 `{RD 20} : TD 20 := {}.
-Instance Ttb20 `{TD 20} : BD (S 20) := {}.
-
-Instance BtL21 `{BD 21} : LD 21 := {}.
-Instance BtR21 `{BD 21} : RD 21 := {}.
-Instance LtR21 `{LD 21} : TD 21 := {}.
-Instance RtR21 `{RD 21} : TD 21 := {}.
-Instance Ttb21 `{TD 21} : BD (S 21) := {}.
-
-Instance BtL22 `{BD 22} : LD 22 := {}.
-Instance BtR22 `{BD 22} : RD 22 := {}.
-Instance LtR22 `{LD 22} : TD 22 := {}.
-Instance RtR22 `{RD 22} : TD 22 := {}.
-Instance Ttb22 `{TD 22} : BD (S 22) := {}.
-
-Instance BtL23 `{BD 23} : LD 23 := {}.
-Instance BtR23 `{BD 23} : RD 23 := {}.
-Instance LtR23 `{LD 23} : TD 23 := {}.
-Instance RtR23 `{RD 23} : TD 23 := {}.
-Instance Ttb23 `{TD 23} : BD (S 23) := {}.
-
-Instance BtL24 `{BD 24} : LD 24 := {}.
-Instance BtR24 `{BD 24} : RD 24 := {}.
-Instance LtR24 `{LD 24} : TD 24 := {}.
-Instance RtR24 `{RD 24} : TD 24 := {}.
-Instance Ttb24 `{TD 24} : BD (S 24) := {}.
-
-Instance BtL25 `{BD 25} : LD 25 := {}.
-Instance BtR25 `{BD 25} : RD 25 := {}.
-Instance LtR25 `{LD 25} : TD 25 := {}.
-Instance RtR25 `{RD 25} : TD 25 := {}.
-Instance Ttb25 `{TD 25} : BD (S 25) := {}.
-
-Instance BtL26 `{BD 26} : LD 26 := {}.
-Instance BtR26 `{BD 26} : RD 26 := {}.
-Instance LtR26 `{LD 26} : TD 26 := {}.
-Instance RtR26 `{RD 26} : TD 26 := {}.
-Instance Ttb26 `{TD 26} : BD (S 26) := {}.
-
-Instance BtL27 `{BD 27} : LD 27 := {}.
-Instance BtR27 `{BD 27} : RD 27 := {}.
-Instance LtR27 `{LD 27} : TD 27 := {}.
-Instance RtR27 `{RD 27} : TD 27 := {}.
-Instance Ttb27 `{TD 27} : BD (S 27) := {}.
-
-Instance BtL28 `{BD 28} : LD 28 := {}.
-Instance BtR28 `{BD 28} : RD 28 := {}.
-Instance LtR28 `{LD 28} : TD 28 := {}.
-Instance RtR28 `{RD 28} : TD 28 := {}.
-Instance Ttb28 `{TD 28} : BD (S 28) := {}.
-
-Instance BtL29 `{BD 29} : LD 29 := {}.
-Instance BtR29 `{BD 29} : RD 29 := {}.
-Instance LtR29 `{LD 29} : TD 29 := {}.
-Instance RtR29 `{RD 29} : TD 29 := {}.
-Instance Ttb29 `{TD 29} : BD (S 29) := {}.
-
-Instance BtL30 `{BD 30} : LD 30 := {}.
-Instance BtR30 `{BD 30} : RD 30 := {}.
-Instance LtR30 `{LD 30} : TD 30 := {}.
-Instance RtR30 `{RD 30} : TD 30 := {}.
-Instance Ttb30 `{TD 30} : BD (S 30) := {}.
-
-Instance BtL31 `{BD 31} : LD 31 := {}.
-Instance BtR31 `{BD 31} : RD 31 := {}.
-Instance LtR31 `{LD 31} : TD 31 := {}.
-Instance RtR31 `{RD 31} : TD 31 := {}.
-Instance Ttb31 `{TD 31} : BD (S 31) := {}.
-
-Instance BtL32 `{BD 32} : LD 32 := {}.
-Instance BtR32 `{BD 32} : RD 32 := {}.
-Instance LtR32 `{LD 32} : TD 32 := {}.
-Instance RtR32 `{RD 32} : TD 32 := {}.
-Instance Ttb32 `{TD 32} : BD (S 32) := {}.
-
-Instance BtL33 `{BD 33} : LD 33 := {}.
-Instance BtR33 `{BD 33} : RD 33 := {}.
-Instance LtR33 `{LD 33} : TD 33 := {}.
-Instance RtR33 `{RD 33} : TD 33 := {}.
-Instance Ttb33 `{TD 33} : BD (S 33) := {}.
-
-Instance BtL34 `{BD 34} : LD 34 := {}.
-Instance BtR34 `{BD 34} : RD 34 := {}.
-Instance LtR34 `{LD 34} : TD 34 := {}.
-Instance RtR34 `{RD 34} : TD 34 := {}.
-Instance Ttb34 `{TD 34} : BD (S 34) := {}.
-
-Instance BtL35 `{BD 35} : LD 35 := {}.
-Instance BtR35 `{BD 35} : RD 35 := {}.
-Instance LtR35 `{LD 35} : TD 35 := {}.
-Instance RtR35 `{RD 35} : TD 35 := {}.
-Instance Ttb35 `{TD 35} : BD (S 35) := {}.
-
-Instance BtL36 `{BD 36} : LD 36 := {}.
-Instance BtR36 `{BD 36} : RD 36 := {}.
-Instance LtR36 `{LD 36} : TD 36 := {}.
-Instance RtR36 `{RD 36} : TD 36 := {}.
-Instance Ttb36 `{TD 36} : BD (S 36) := {}.
-
-Instance BtL37 `{BD 37} : LD 37 := {}.
-Instance BtR37 `{BD 37} : RD 37 := {}.
-Instance LtR37 `{LD 37} : TD 37 := {}.
-Instance RtR37 `{RD 37} : TD 37 := {}.
-Instance Ttb37 `{TD 37} : BD (S 37) := {}.
-
-Instance BtL38 `{BD 38} : LD 38 := {}.
-Instance BtR38 `{BD 38} : RD 38 := {}.
-Instance LtR38 `{LD 38} : TD 38 := {}.
-Instance RtR38 `{RD 38} : TD 38 := {}.
-Instance Ttb38 `{TD 38} : BD (S 38) := {}.
-
-Instance BtL39 `{BD 39} : LD 39 := {}.
-Instance BtR39 `{BD 39} : RD 39 := {}.
-Instance LtR39 `{LD 39} : TD 39 := {}.
-Instance RtR39 `{RD 39} : TD 39 := {}.
-Instance Ttb39 `{TD 39} : BD (S 39) := {}.
-
-Instance BtL40 `{BD 40} : LD 40 := {}.
-Instance BtR40 `{BD 40} : RD 40 := {}.
-Instance LtR40 `{LD 40} : TD 40 := {}.
-Instance RtR40 `{RD 40} : TD 40 := {}.
-Instance Ttb40 `{TD 40} : BD (S 40) := {}.
-
-Instance BtL41 `{BD 41} : LD 41 := {}.
-Instance BtR41 `{BD 41} : RD 41 := {}.
-Instance LtR41 `{LD 41} : TD 41 := {}.
-Instance RtR41 `{RD 41} : TD 41 := {}.
-Instance Ttb41 `{TD 41} : BD (S 41) := {}.
-
-Instance BtL42 `{BD 42} : LD 42 := {}.
-Instance BtR42 `{BD 42} : RD 42 := {}.
-Instance LtR42 `{LD 42} : TD 42 := {}.
-Instance RtR42 `{RD 42} : TD 42 := {}.
-Instance Ttb42 `{TD 42} : BD (S 42) := {}.
-
-Instance BtL43 `{BD 43} : LD 43 := {}.
-Instance BtR43 `{BD 43} : RD 43 := {}.
-Instance LtR43 `{LD 43} : TD 43 := {}.
-Instance RtR43 `{RD 43} : TD 43 := {}.
-Instance Ttb43 `{TD 43} : BD (S 43) := {}.
-
-Instance BtL44 `{BD 44} : LD 44 := {}.
-Instance BtR44 `{BD 44} : RD 44 := {}.
-Instance LtR44 `{LD 44} : TD 44 := {}.
-Instance RtR44 `{RD 44} : TD 44 := {}.
-Instance Ttb44 `{TD 44} : BD (S 44) := {}.
-
-Instance BtL45 `{BD 45} : LD 45 := {}.
-Instance BtR45 `{BD 45} : RD 45 := {}.
-Instance LtR45 `{LD 45} : TD 45 := {}.
-Instance RtR45 `{RD 45} : TD 45 := {}.
-Instance Ttb45 `{TD 45} : BD (S 45) := {}.
-
-Instance BtL46 `{BD 46} : LD 46 := {}.
-Instance BtR46 `{BD 46} : RD 46 := {}.
-Instance LtR46 `{LD 46} : TD 46 := {}.
-Instance RtR46 `{RD 46} : TD 46 := {}.
-Instance Ttb46 `{TD 46} : BD (S 46) := {}.
-
-Instance BtL47 `{BD 47} : LD 47 := {}.
-Instance BtR47 `{BD 47} : RD 47 := {}.
-Instance LtR47 `{LD 47} : TD 47 := {}.
-Instance RtR47 `{RD 47} : TD 47 := {}.
-Instance Ttb47 `{TD 47} : BD (S 47) := {}.
-
-Instance BtL48 `{BD 48} : LD 48 := {}.
-Instance BtR48 `{BD 48} : RD 48 := {}.
-Instance LtR48 `{LD 48} : TD 48 := {}.
-Instance RtR48 `{RD 48} : TD 48 := {}.
-Instance Ttb48 `{TD 48} : BD (S 48) := {}.
-
-Instance BtL49 `{BD 49} : LD 49 := {}.
-Instance BtR49 `{BD 49} : RD 49 := {}.
-Instance LtR49 `{LD 49} : TD 49 := {}.
-Instance RtR49 `{RD 49} : TD 49 := {}.
-Instance Ttb49 `{TD 49} : BD (S 49) := {}.
-
-Instance BtL50 `{BD 50} : LD 50 := {}.
-Instance BtR50 `{BD 50} : RD 50 := {}.
-Instance LtR50 `{LD 50} : TD 50 := {}.
-Instance RtR50 `{RD 50} : TD 50 := {}.
-Instance Ttb50 `{TD 50} : BD (S 50) := {}.
-
-Instance BtL51 `{BD 51} : LD 51 := {}.
-Instance BtR51 `{BD 51} : RD 51 := {}.
-Instance LtR51 `{LD 51} : TD 51 := {}.
-Instance RtR51 `{RD 51} : TD 51 := {}.
-Instance Ttb51 `{TD 51} : BD (S 51) := {}.
-
-Instance BtL52 `{BD 52} : LD 52 := {}.
-Instance BtR52 `{BD 52} : RD 52 := {}.
-Instance LtR52 `{LD 52} : TD 52 := {}.
-Instance RtR52 `{RD 52} : TD 52 := {}.
-Instance Ttb52 `{TD 52} : BD (S 52) := {}.
-
-Instance BtL53 `{BD 53} : LD 53 := {}.
-Instance BtR53 `{BD 53} : RD 53 := {}.
-Instance LtR53 `{LD 53} : TD 53 := {}.
-Instance RtR53 `{RD 53} : TD 53 := {}.
-Instance Ttb53 `{TD 53} : BD (S 53) := {}.
-
-Instance BtL54 `{BD 54} : LD 54 := {}.
-Instance BtR54 `{BD 54} : RD 54 := {}.
-Instance LtR54 `{LD 54} : TD 54 := {}.
-Instance RtR54 `{RD 54} : TD 54 := {}.
-Instance Ttb54 `{TD 54} : BD (S 54) := {}.
-
-Instance BtL55 `{BD 55} : LD 55 := {}.
-Instance BtR55 `{BD 55} : RD 55 := {}.
-Instance LtR55 `{LD 55} : TD 55 := {}.
-Instance RtR55 `{RD 55} : TD 55 := {}.
-Instance Ttb55 `{TD 55} : BD (S 55) := {}.
-
-Instance BtL56 `{BD 56} : LD 56 := {}.
-Instance BtR56 `{BD 56} : RD 56 := {}.
-Instance LtR56 `{LD 56} : TD 56 := {}.
-Instance RtR56 `{RD 56} : TD 56 := {}.
-Instance Ttb56 `{TD 56} : BD (S 56) := {}.
-
-Instance BtL57 `{BD 57} : LD 57 := {}.
-Instance BtR57 `{BD 57} : RD 57 := {}.
-Instance LtR57 `{LD 57} : TD 57 := {}.
-Instance RtR57 `{RD 57} : TD 57 := {}.
-Instance Ttb57 `{TD 57} : BD (S 57) := {}.
-
-Instance BtL58 `{BD 58} : LD 58 := {}.
-Instance BtR58 `{BD 58} : RD 58 := {}.
-Instance LtR58 `{LD 58} : TD 58 := {}.
-Instance RtR58 `{RD 58} : TD 58 := {}.
-Instance Ttb58 `{TD 58} : BD (S 58) := {}.
-
-Instance BtL59 `{BD 59} : LD 59 := {}.
-Instance BtR59 `{BD 59} : RD 59 := {}.
-Instance LtR59 `{LD 59} : TD 59 := {}.
-Instance RtR59 `{RD 59} : TD 59 := {}.
-Instance Ttb59 `{TD 59} : BD (S 59) := {}.
-
-Instance BtL60 `{BD 60} : LD 60 := {}.
-Instance BtR60 `{BD 60} : RD 60 := {}.
-Instance LtR60 `{LD 60} : TD 60 := {}.
-Instance RtR60 `{RD 60} : TD 60 := {}.
-Instance Ttb60 `{TD 60} : BD (S 60) := {}.
-
-Instance BtL61 `{BD 61} : LD 61 := {}.
-Instance BtR61 `{BD 61} : RD 61 := {}.
-Instance LtR61 `{LD 61} : TD 61 := {}.
-Instance RtR61 `{RD 61} : TD 61 := {}.
-Instance Ttb61 `{TD 61} : BD (S 61) := {}.
-
-Instance BtL62 `{BD 62} : LD 62 := {}.
-Instance BtR62 `{BD 62} : RD 62 := {}.
-Instance LtR62 `{LD 62} : TD 62 := {}.
-Instance RtR62 `{RD 62} : TD 62 := {}.
-Instance Ttb62 `{TD 62} : BD (S 62) := {}.
-
-Instance BtL63 `{BD 63} : LD 63 := {}.
-Instance BtR63 `{BD 63} : RD 63 := {}.
-Instance LtR63 `{LD 63} : TD 63 := {}.
-Instance RtR63 `{RD 63} : TD 63 := {}.
-Instance Ttb63 `{TD 63} : BD (S 63) := {}.
-
-Instance BtL64 `{BD 64} : LD 64 := {}.
-Instance BtR64 `{BD 64} : RD 64 := {}.
-Instance LtR64 `{LD 64} : TD 64 := {}.
-Instance RtR64 `{RD 64} : TD 64 := {}.
-Instance Ttb64 `{TD 64} : BD (S 64) := {}.
-
-Instance BtL65 `{BD 65} : LD 65 := {}.
-Instance BtR65 `{BD 65} : RD 65 := {}.
-Instance LtR65 `{LD 65} : TD 65 := {}.
-Instance RtR65 `{RD 65} : TD 65 := {}.
-Instance Ttb65 `{TD 65} : BD (S 65) := {}.
-
-Instance BtL66 `{BD 66} : LD 66 := {}.
-Instance BtR66 `{BD 66} : RD 66 := {}.
-Instance LtR66 `{LD 66} : TD 66 := {}.
-Instance RtR66 `{RD 66} : TD 66 := {}.
-Instance Ttb66 `{TD 66} : BD (S 66) := {}.
-
-Instance BtL67 `{BD 67} : LD 67 := {}.
-Instance BtR67 `{BD 67} : RD 67 := {}.
-Instance LtR67 `{LD 67} : TD 67 := {}.
-Instance RtR67 `{RD 67} : TD 67 := {}.
-Instance Ttb67 `{TD 67} : BD (S 67) := {}.
-
-Instance BtL68 `{BD 68} : LD 68 := {}.
-Instance BtR68 `{BD 68} : RD 68 := {}.
-Instance LtR68 `{LD 68} : TD 68 := {}.
-Instance RtR68 `{RD 68} : TD 68 := {}.
-Instance Ttb68 `{TD 68} : BD (S 68) := {}.
-
-Instance BtL69 `{BD 69} : LD 69 := {}.
-Instance BtR69 `{BD 69} : RD 69 := {}.
-Instance LtR69 `{LD 69} : TD 69 := {}.
-Instance RtR69 `{RD 69} : TD 69 := {}.
-Instance Ttb69 `{TD 69} : BD (S 69) := {}.
-
-Instance BtL70 `{BD 70} : LD 70 := {}.
-Instance BtR70 `{BD 70} : RD 70 := {}.
-Instance LtR70 `{LD 70} : TD 70 := {}.
-Instance RtR70 `{RD 70} : TD 70 := {}.
-Instance Ttb70 `{TD 70} : BD (S 70) := {}.
-
-Instance BtL71 `{BD 71} : LD 71 := {}.
-Instance BtR71 `{BD 71} : RD 71 := {}.
-Instance LtR71 `{LD 71} : TD 71 := {}.
-Instance RtR71 `{RD 71} : TD 71 := {}.
-Instance Ttb71 `{TD 71} : BD (S 71) := {}.
-
-Instance BtL72 `{BD 72} : LD 72 := {}.
-Instance BtR72 `{BD 72} : RD 72 := {}.
-Instance LtR72 `{LD 72} : TD 72 := {}.
-Instance RtR72 `{RD 72} : TD 72 := {}.
-Instance Ttb72 `{TD 72} : BD (S 72) := {}.
-
-Instance BtL73 `{BD 73} : LD 73 := {}.
-Instance BtR73 `{BD 73} : RD 73 := {}.
-Instance LtR73 `{LD 73} : TD 73 := {}.
-Instance RtR73 `{RD 73} : TD 73 := {}.
-Instance Ttb73 `{TD 73} : BD (S 73) := {}.
-
-Instance BtL74 `{BD 74} : LD 74 := {}.
-Instance BtR74 `{BD 74} : RD 74 := {}.
-Instance LtR74 `{LD 74} : TD 74 := {}.
-Instance RtR74 `{RD 74} : TD 74 := {}.
-Instance Ttb74 `{TD 74} : BD (S 74) := {}.
-
-Instance BtL75 `{BD 75} : LD 75 := {}.
-Instance BtR75 `{BD 75} : RD 75 := {}.
-Instance LtR75 `{LD 75} : TD 75 := {}.
-Instance RtR75 `{RD 75} : TD 75 := {}.
-Instance Ttb75 `{TD 75} : BD (S 75) := {}.
-
-Instance BtL76 `{BD 76} : LD 76 := {}.
-Instance BtR76 `{BD 76} : RD 76 := {}.
-Instance LtR76 `{LD 76} : TD 76 := {}.
-Instance RtR76 `{RD 76} : TD 76 := {}.
-Instance Ttb76 `{TD 76} : BD (S 76) := {}.
-
-Instance BtL77 `{BD 77} : LD 77 := {}.
-Instance BtR77 `{BD 77} : RD 77 := {}.
-Instance LtR77 `{LD 77} : TD 77 := {}.
-Instance RtR77 `{RD 77} : TD 77 := {}.
-Instance Ttb77 `{TD 77} : BD (S 77) := {}.
-
-Instance BtL78 `{BD 78} : LD 78 := {}.
-Instance BtR78 `{BD 78} : RD 78 := {}.
-Instance LtR78 `{LD 78} : TD 78 := {}.
-Instance RtR78 `{RD 78} : TD 78 := {}.
-Instance Ttb78 `{TD 78} : BD (S 78) := {}.
-
-Instance BtL79 `{BD 79} : LD 79 := {}.
-Instance BtR79 `{BD 79} : RD 79 := {}.
-Instance LtR79 `{LD 79} : TD 79 := {}.
-Instance RtR79 `{RD 79} : TD 79 := {}.
-Instance Ttb79 `{TD 79} : BD (S 79) := {}.
-
-Instance BtL80 `{BD 80} : LD 80 := {}.
-Instance BtR80 `{BD 80} : RD 80 := {}.
-Instance LtR80 `{LD 80} : TD 80 := {}.
-Instance RtR80 `{RD 80} : TD 80 := {}.
-Instance Ttb80 `{TD 80} : BD (S 80) := {}.
-
-Instance BtL81 `{BD 81} : LD 81 := {}.
-Instance BtR81 `{BD 81} : RD 81 := {}.
-Instance LtR81 `{LD 81} : TD 81 := {}.
-Instance RtR81 `{RD 81} : TD 81 := {}.
-Instance Ttb81 `{TD 81} : BD (S 81) := {}.
-
-Instance BtL82 `{BD 82} : LD 82 := {}.
-Instance BtR82 `{BD 82} : RD 82 := {}.
-Instance LtR82 `{LD 82} : TD 82 := {}.
-Instance RtR82 `{RD 82} : TD 82 := {}.
-Instance Ttb82 `{TD 82} : BD (S 82) := {}.
-
-Instance BtL83 `{BD 83} : LD 83 := {}.
-Instance BtR83 `{BD 83} : RD 83 := {}.
-Instance LtR83 `{LD 83} : TD 83 := {}.
-Instance RtR83 `{RD 83} : TD 83 := {}.
-Instance Ttb83 `{TD 83} : BD (S 83) := {}.
-
-Instance BtL84 `{BD 84} : LD 84 := {}.
-Instance BtR84 `{BD 84} : RD 84 := {}.
-Instance LtR84 `{LD 84} : TD 84 := {}.
-Instance RtR84 `{RD 84} : TD 84 := {}.
-Instance Ttb84 `{TD 84} : BD (S 84) := {}.
-
-Instance BtL85 `{BD 85} : LD 85 := {}.
-Instance BtR85 `{BD 85} : RD 85 := {}.
-Instance LtR85 `{LD 85} : TD 85 := {}.
-Instance RtR85 `{RD 85} : TD 85 := {}.
-Instance Ttb85 `{TD 85} : BD (S 85) := {}.
-
-Instance BtL86 `{BD 86} : LD 86 := {}.
-Instance BtR86 `{BD 86} : RD 86 := {}.
-Instance LtR86 `{LD 86} : TD 86 := {}.
-Instance RtR86 `{RD 86} : TD 86 := {}.
-Instance Ttb86 `{TD 86} : BD (S 86) := {}.
-
-Instance BtL87 `{BD 87} : LD 87 := {}.
-Instance BtR87 `{BD 87} : RD 87 := {}.
-Instance LtR87 `{LD 87} : TD 87 := {}.
-Instance RtR87 `{RD 87} : TD 87 := {}.
-Instance Ttb87 `{TD 87} : BD (S 87) := {}.
-
-Instance BtL88 `{BD 88} : LD 88 := {}.
-Instance BtR88 `{BD 88} : RD 88 := {}.
-Instance LtR88 `{LD 88} : TD 88 := {}.
-Instance RtR88 `{RD 88} : TD 88 := {}.
-Instance Ttb88 `{TD 88} : BD (S 88) := {}.
-
-Instance BtL89 `{BD 89} : LD 89 := {}.
-Instance BtR89 `{BD 89} : RD 89 := {}.
-Instance LtR89 `{LD 89} : TD 89 := {}.
-Instance RtR89 `{RD 89} : TD 89 := {}.
-Instance Ttb89 `{TD 89} : BD (S 89) := {}.
-
-Instance BtL90 `{BD 90} : LD 90 := {}.
-Instance BtR90 `{BD 90} : RD 90 := {}.
-Instance LtR90 `{LD 90} : TD 90 := {}.
-Instance RtR90 `{RD 90} : TD 90 := {}.
-Instance Ttb90 `{TD 90} : BD (S 90) := {}.
-
-Instance BtL91 `{BD 91} : LD 91 := {}.
-Instance BtR91 `{BD 91} : RD 91 := {}.
-Instance LtR91 `{LD 91} : TD 91 := {}.
-Instance RtR91 `{RD 91} : TD 91 := {}.
-Instance Ttb91 `{TD 91} : BD (S 91) := {}.
-
-Instance BtL92 `{BD 92} : LD 92 := {}.
-Instance BtR92 `{BD 92} : RD 92 := {}.
-Instance LtR92 `{LD 92} : TD 92 := {}.
-Instance RtR92 `{RD 92} : TD 92 := {}.
-Instance Ttb92 `{TD 92} : BD (S 92) := {}.
-
-Instance BtL93 `{BD 93} : LD 93 := {}.
-Instance BtR93 `{BD 93} : RD 93 := {}.
-Instance LtR93 `{LD 93} : TD 93 := {}.
-Instance RtR93 `{RD 93} : TD 93 := {}.
-Instance Ttb93 `{TD 93} : BD (S 93) := {}.
-
-Instance BtL94 `{BD 94} : LD 94 := {}.
-Instance BtR94 `{BD 94} : RD 94 := {}.
-Instance LtR94 `{LD 94} : TD 94 := {}.
-Instance RtR94 `{RD 94} : TD 94 := {}.
-Instance Ttb94 `{TD 94} : BD (S 94) := {}.
-
-Instance BtL95 `{BD 95} : LD 95 := {}.
-Instance BtR95 `{BD 95} : RD 95 := {}.
-Instance LtR95 `{LD 95} : TD 95 := {}.
-Instance RtR95 `{RD 95} : TD 95 := {}.
-Instance Ttb95 `{TD 95} : BD (S 95) := {}.
-
-Instance BtL96 `{BD 96} : LD 96 := {}.
-Instance BtR96 `{BD 96} : RD 96 := {}.
-Instance LtR96 `{LD 96} : TD 96 := {}.
-Instance RtR96 `{RD 96} : TD 96 := {}.
-Instance Ttb96 `{TD 96} : BD (S 96) := {}.
-
-Instance BtL97 `{BD 97} : LD 97 := {}.
-Instance BtR97 `{BD 97} : RD 97 := {}.
-Instance LtR97 `{LD 97} : TD 97 := {}.
-Instance RtR97 `{RD 97} : TD 97 := {}.
-Instance Ttb97 `{TD 97} : BD (S 97) := {}.
-
-Instance BtL98 `{BD 98} : LD 98 := {}.
-Instance BtR98 `{BD 98} : RD 98 := {}.
-Instance LtR98 `{LD 98} : TD 98 := {}.
-Instance RtR98 `{RD 98} : TD 98 := {}.
-Instance Ttb98 `{TD 98} : BD (S 98) := {}.
-
-Instance BtL99 `{BD 99} : LD 99 := {}.
-Instance BtR99 `{BD 99} : RD 99 := {}.
-Instance LtR99 `{LD 99} : TD 99 := {}.
-Instance RtR99 `{RD 99} : TD 99 := {}.
-Instance Ttb99 `{TD 99} : BD (S 99) := {}.
-
-Instance BtL100 `{BD 100} : LD 100 := {}.
-Instance BtR100 `{BD 100} : RD 100 := {}.
-Instance LtR100 `{LD 100} : TD 100 := {}.
-Instance RtR100 `{RD 100} : TD 100 := {}.
-Instance Ttb100 `{TD 100} : BD (S 100) := {}.
-
-Instance BtL101 `{BD 101} : LD 101 := {}.
-Instance BtR101 `{BD 101} : RD 101 := {}.
-Instance LtR101 `{LD 101} : TD 101 := {}.
-Instance RtR101 `{RD 101} : TD 101 := {}.
-Instance Ttb101 `{TD 101} : BD (S 101) := {}.
-
-Instance BtL102 `{BD 102} : LD 102 := {}.
-Instance BtR102 `{BD 102} : RD 102 := {}.
-Instance LtR102 `{LD 102} : TD 102 := {}.
-Instance RtR102 `{RD 102} : TD 102 := {}.
-Instance Ttb102 `{TD 102} : BD (S 102) := {}.
-
-Instance BtL103 `{BD 103} : LD 103 := {}.
-Instance BtR103 `{BD 103} : RD 103 := {}.
-Instance LtR103 `{LD 103} : TD 103 := {}.
-Instance RtR103 `{RD 103} : TD 103 := {}.
-Instance Ttb103 `{TD 103} : BD (S 103) := {}.
-
-Instance BtL104 `{BD 104} : LD 104 := {}.
-Instance BtR104 `{BD 104} : RD 104 := {}.
-Instance LtR104 `{LD 104} : TD 104 := {}.
-Instance RtR104 `{RD 104} : TD 104 := {}.
-Instance Ttb104 `{TD 104} : BD (S 104) := {}.
-
-Instance BtL105 `{BD 105} : LD 105 := {}.
-Instance BtR105 `{BD 105} : RD 105 := {}.
-Instance LtR105 `{LD 105} : TD 105 := {}.
-Instance RtR105 `{RD 105} : TD 105 := {}.
-Instance Ttb105 `{TD 105} : BD (S 105) := {}.
-
-Instance BtL106 `{BD 106} : LD 106 := {}.
-Instance BtR106 `{BD 106} : RD 106 := {}.
-Instance LtR106 `{LD 106} : TD 106 := {}.
-Instance RtR106 `{RD 106} : TD 106 := {}.
-Instance Ttb106 `{TD 106} : BD (S 106) := {}.
-
-Instance BtL107 `{BD 107} : LD 107 := {}.
-Instance BtR107 `{BD 107} : RD 107 := {}.
-Instance LtR107 `{LD 107} : TD 107 := {}.
-Instance RtR107 `{RD 107} : TD 107 := {}.
-Instance Ttb107 `{TD 107} : BD (S 107) := {}.
-
-Instance BtL108 `{BD 108} : LD 108 := {}.
-Instance BtR108 `{BD 108} : RD 108 := {}.
-Instance LtR108 `{LD 108} : TD 108 := {}.
-Instance RtR108 `{RD 108} : TD 108 := {}.
-Instance Ttb108 `{TD 108} : BD (S 108) := {}.
-
-Instance BtL109 `{BD 109} : LD 109 := {}.
-Instance BtR109 `{BD 109} : RD 109 := {}.
-Instance LtR109 `{LD 109} : TD 109 := {}.
-Instance RtR109 `{RD 109} : TD 109 := {}.
-Instance Ttb109 `{TD 109} : BD (S 109) := {}.
-
-Instance BtL110 `{BD 110} : LD 110 := {}.
-Instance BtR110 `{BD 110} : RD 110 := {}.
-Instance LtR110 `{LD 110} : TD 110 := {}.
-Instance RtR110 `{RD 110} : TD 110 := {}.
-Instance Ttb110 `{TD 110} : BD (S 110) := {}.
-
-Instance BtL111 `{BD 111} : LD 111 := {}.
-Instance BtR111 `{BD 111} : RD 111 := {}.
-Instance LtR111 `{LD 111} : TD 111 := {}.
-Instance RtR111 `{RD 111} : TD 111 := {}.
-Instance Ttb111 `{TD 111} : BD (S 111) := {}.
-
-Instance BtL112 `{BD 112} : LD 112 := {}.
-Instance BtR112 `{BD 112} : RD 112 := {}.
-Instance LtR112 `{LD 112} : TD 112 := {}.
-Instance RtR112 `{RD 112} : TD 112 := {}.
-Instance Ttb112 `{TD 112} : BD (S 112) := {}.
-
-Instance BtL113 `{BD 113} : LD 113 := {}.
-Instance BtR113 `{BD 113} : RD 113 := {}.
-Instance LtR113 `{LD 113} : TD 113 := {}.
-Instance RtR113 `{RD 113} : TD 113 := {}.
-Instance Ttb113 `{TD 113} : BD (S 113) := {}.
-
-Instance BtL114 `{BD 114} : LD 114 := {}.
-Instance BtR114 `{BD 114} : RD 114 := {}.
-Instance LtR114 `{LD 114} : TD 114 := {}.
-Instance RtR114 `{RD 114} : TD 114 := {}.
-Instance Ttb114 `{TD 114} : BD (S 114) := {}.
-
-Instance BtL115 `{BD 115} : LD 115 := {}.
-Instance BtR115 `{BD 115} : RD 115 := {}.
-Instance LtR115 `{LD 115} : TD 115 := {}.
-Instance RtR115 `{RD 115} : TD 115 := {}.
-Instance Ttb115 `{TD 115} : BD (S 115) := {}.
-
-Instance BtL116 `{BD 116} : LD 116 := {}.
-Instance BtR116 `{BD 116} : RD 116 := {}.
-Instance LtR116 `{LD 116} : TD 116 := {}.
-Instance RtR116 `{RD 116} : TD 116 := {}.
-Instance Ttb116 `{TD 116} : BD (S 116) := {}.
-
-Instance BtL117 `{BD 117} : LD 117 := {}.
-Instance BtR117 `{BD 117} : RD 117 := {}.
-Instance LtR117 `{LD 117} : TD 117 := {}.
-Instance RtR117 `{RD 117} : TD 117 := {}.
-Instance Ttb117 `{TD 117} : BD (S 117) := {}.
-
-Instance BtL118 `{BD 118} : LD 118 := {}.
-Instance BtR118 `{BD 118} : RD 118 := {}.
-Instance LtR118 `{LD 118} : TD 118 := {}.
-Instance RtR118 `{RD 118} : TD 118 := {}.
-Instance Ttb118 `{TD 118} : BD (S 118) := {}.
-
-Instance BtL119 `{BD 119} : LD 119 := {}.
-Instance BtR119 `{BD 119} : RD 119 := {}.
-Instance LtR119 `{LD 119} : TD 119 := {}.
-Instance RtR119 `{RD 119} : TD 119 := {}.
-Instance Ttb119 `{TD 119} : BD (S 119) := {}.
-
-Instance BtL120 `{BD 120} : LD 120 := {}.
-Instance BtR120 `{BD 120} : RD 120 := {}.
-Instance LtR120 `{LD 120} : TD 120 := {}.
-Instance RtR120 `{RD 120} : TD 120 := {}.
-Instance Ttb120 `{TD 120} : BD (S 120) := {}.
-
-Instance BtL121 `{BD 121} : LD 121 := {}.
-Instance BtR121 `{BD 121} : RD 121 := {}.
-Instance LtR121 `{LD 121} : TD 121 := {}.
-Instance RtR121 `{RD 121} : TD 121 := {}.
-Instance Ttb121 `{TD 121} : BD (S 121) := {}.
-
-Instance BtL122 `{BD 122} : LD 122 := {}.
-Instance BtR122 `{BD 122} : RD 122 := {}.
-Instance LtR122 `{LD 122} : TD 122 := {}.
-Instance RtR122 `{RD 122} : TD 122 := {}.
-Instance Ttb122 `{TD 122} : BD (S 122) := {}.
-
-Instance BtL123 `{BD 123} : LD 123 := {}.
-Instance BtR123 `{BD 123} : RD 123 := {}.
-Instance LtR123 `{LD 123} : TD 123 := {}.
-Instance RtR123 `{RD 123} : TD 123 := {}.
-Instance Ttb123 `{TD 123} : BD (S 123) := {}.
-
-Instance BtL124 `{BD 124} : LD 124 := {}.
-Instance BtR124 `{BD 124} : RD 124 := {}.
-Instance LtR124 `{LD 124} : TD 124 := {}.
-Instance RtR124 `{RD 124} : TD 124 := {}.
-Instance Ttb124 `{TD 124} : BD (S 124) := {}.
-
-Instance BtL125 `{BD 125} : LD 125 := {}.
-Instance BtR125 `{BD 125} : RD 125 := {}.
-Instance LtR125 `{LD 125} : TD 125 := {}.
-Instance RtR125 `{RD 125} : TD 125 := {}.
-Instance Ttb125 `{TD 125} : BD (S 125) := {}.
-
-Instance BtL126 `{BD 126} : LD 126 := {}.
-Instance BtR126 `{BD 126} : RD 126 := {}.
-Instance LtR126 `{LD 126} : TD 126 := {}.
-Instance RtR126 `{RD 126} : TD 126 := {}.
-Instance Ttb126 `{TD 126} : BD (S 126) := {}.
-
-Instance BtL127 `{BD 127} : LD 127 := {}.
-Instance BtR127 `{BD 127} : RD 127 := {}.
-Instance LtR127 `{LD 127} : TD 127 := {}.
-Instance RtR127 `{RD 127} : TD 127 := {}.
-Instance Ttb127 `{TD 127} : BD (S 127) := {}.
-
-Instance BtL128 `{BD 128} : LD 128 := {}.
-Instance BtR128 `{BD 128} : RD 128 := {}.
-Instance LtR128 `{LD 128} : TD 128 := {}.
-Instance RtR128 `{RD 128} : TD 128 := {}.
-Instance Ttb128 `{TD 128} : BD (S 128) := {}.
-
-Instance BtL129 `{BD 129} : LD 129 := {}.
-Instance BtR129 `{BD 129} : RD 129 := {}.
-Instance LtR129 `{LD 129} : TD 129 := {}.
-Instance RtR129 `{RD 129} : TD 129 := {}.
-Instance Ttb129 `{TD 129} : BD (S 129) := {}.
-
-Instance BtL130 `{BD 130} : LD 130 := {}.
-Instance BtR130 `{BD 130} : RD 130 := {}.
-Instance LtR130 `{LD 130} : TD 130 := {}.
-Instance RtR130 `{RD 130} : TD 130 := {}.
-Instance Ttb130 `{TD 130} : BD (S 130) := {}.
-
-Instance BtL131 `{BD 131} : LD 131 := {}.
-Instance BtR131 `{BD 131} : RD 131 := {}.
-Instance LtR131 `{LD 131} : TD 131 := {}.
-Instance RtR131 `{RD 131} : TD 131 := {}.
-Instance Ttb131 `{TD 131} : BD (S 131) := {}.
-
-Instance BtL132 `{BD 132} : LD 132 := {}.
-Instance BtR132 `{BD 132} : RD 132 := {}.
-Instance LtR132 `{LD 132} : TD 132 := {}.
-Instance RtR132 `{RD 132} : TD 132 := {}.
-Instance Ttb132 `{TD 132} : BD (S 132) := {}.
-
-Instance BtL133 `{BD 133} : LD 133 := {}.
-Instance BtR133 `{BD 133} : RD 133 := {}.
-Instance LtR133 `{LD 133} : TD 133 := {}.
-Instance RtR133 `{RD 133} : TD 133 := {}.
-Instance Ttb133 `{TD 133} : BD (S 133) := {}.
-
-Instance BtL134 `{BD 134} : LD 134 := {}.
-Instance BtR134 `{BD 134} : RD 134 := {}.
-Instance LtR134 `{LD 134} : TD 134 := {}.
-Instance RtR134 `{RD 134} : TD 134 := {}.
-Instance Ttb134 `{TD 134} : BD (S 134) := {}.
-
-Instance BtL135 `{BD 135} : LD 135 := {}.
-Instance BtR135 `{BD 135} : RD 135 := {}.
-Instance LtR135 `{LD 135} : TD 135 := {}.
-Instance RtR135 `{RD 135} : TD 135 := {}.
-Instance Ttb135 `{TD 135} : BD (S 135) := {}.
-
-Instance BtL136 `{BD 136} : LD 136 := {}.
-Instance BtR136 `{BD 136} : RD 136 := {}.
-Instance LtR136 `{LD 136} : TD 136 := {}.
-Instance RtR136 `{RD 136} : TD 136 := {}.
-Instance Ttb136 `{TD 136} : BD (S 136) := {}.
-
-Instance BtL137 `{BD 137} : LD 137 := {}.
-Instance BtR137 `{BD 137} : RD 137 := {}.
-Instance LtR137 `{LD 137} : TD 137 := {}.
-Instance RtR137 `{RD 137} : TD 137 := {}.
-Instance Ttb137 `{TD 137} : BD (S 137) := {}.
-
-Instance BtL138 `{BD 138} : LD 138 := {}.
-Instance BtR138 `{BD 138} : RD 138 := {}.
-Instance LtR138 `{LD 138} : TD 138 := {}.
-Instance RtR138 `{RD 138} : TD 138 := {}.
-Instance Ttb138 `{TD 138} : BD (S 138) := {}.
-
-Instance BtL139 `{BD 139} : LD 139 := {}.
-Instance BtR139 `{BD 139} : RD 139 := {}.
-Instance LtR139 `{LD 139} : TD 139 := {}.
-Instance RtR139 `{RD 139} : TD 139 := {}.
-Instance Ttb139 `{TD 139} : BD (S 139) := {}.
-
-Instance BtL140 `{BD 140} : LD 140 := {}.
-Instance BtR140 `{BD 140} : RD 140 := {}.
-Instance LtR140 `{LD 140} : TD 140 := {}.
-Instance RtR140 `{RD 140} : TD 140 := {}.
-Instance Ttb140 `{TD 140} : BD (S 140) := {}.
-
-Instance BtL141 `{BD 141} : LD 141 := {}.
-Instance BtR141 `{BD 141} : RD 141 := {}.
-Instance LtR141 `{LD 141} : TD 141 := {}.
-Instance RtR141 `{RD 141} : TD 141 := {}.
-Instance Ttb141 `{TD 141} : BD (S 141) := {}.
-
-Instance BtL142 `{BD 142} : LD 142 := {}.
-Instance BtR142 `{BD 142} : RD 142 := {}.
-Instance LtR142 `{LD 142} : TD 142 := {}.
-Instance RtR142 `{RD 142} : TD 142 := {}.
-Instance Ttb142 `{TD 142} : BD (S 142) := {}.
-
-Instance BtL143 `{BD 143} : LD 143 := {}.
-Instance BtR143 `{BD 143} : RD 143 := {}.
-Instance LtR143 `{LD 143} : TD 143 := {}.
-Instance RtR143 `{RD 143} : TD 143 := {}.
-Instance Ttb143 `{TD 143} : BD (S 143) := {}.
-
-Instance BtL144 `{BD 144} : LD 144 := {}.
-Instance BtR144 `{BD 144} : RD 144 := {}.
-Instance LtR144 `{LD 144} : TD 144 := {}.
-Instance RtR144 `{RD 144} : TD 144 := {}.
-Instance Ttb144 `{TD 144} : BD (S 144) := {}.
-
-Instance BtL145 `{BD 145} : LD 145 := {}.
-Instance BtR145 `{BD 145} : RD 145 := {}.
-Instance LtR145 `{LD 145} : TD 145 := {}.
-Instance RtR145 `{RD 145} : TD 145 := {}.
-Instance Ttb145 `{TD 145} : BD (S 145) := {}.
-
-Instance BtL146 `{BD 146} : LD 146 := {}.
-Instance BtR146 `{BD 146} : RD 146 := {}.
-Instance LtR146 `{LD 146} : TD 146 := {}.
-Instance RtR146 `{RD 146} : TD 146 := {}.
-Instance Ttb146 `{TD 146} : BD (S 146) := {}.
-
-Instance BtL147 `{BD 147} : LD 147 := {}.
-Instance BtR147 `{BD 147} : RD 147 := {}.
-Instance LtR147 `{LD 147} : TD 147 := {}.
-Instance RtR147 `{RD 147} : TD 147 := {}.
-Instance Ttb147 `{TD 147} : BD (S 147) := {}.
-
-Instance BtL148 `{BD 148} : LD 148 := {}.
-Instance BtR148 `{BD 148} : RD 148 := {}.
-Instance LtR148 `{LD 148} : TD 148 := {}.
-Instance RtR148 `{RD 148} : TD 148 := {}.
-Instance Ttb148 `{TD 148} : BD (S 148) := {}.
-
-Instance BtL149 `{BD 149} : LD 149 := {}.
-Instance BtR149 `{BD 149} : RD 149 := {}.
-Instance LtR149 `{LD 149} : TD 149 := {}.
-Instance RtR149 `{RD 149} : TD 149 := {}.
-Instance Ttb149 `{TD 149} : BD (S 149) := {}.
-
-Instance BtL150 `{BD 150} : LD 150 := {}.
-Instance BtR150 `{BD 150} : RD 150 := {}.
-Instance LtR150 `{LD 150} : TD 150 := {}.
-Instance RtR150 `{RD 150} : TD 150 := {}.
-Instance Ttb150 `{TD 150} : BD (S 150) := {}.
-
-Instance BtL151 `{BD 151} : LD 151 := {}.
-Instance BtR151 `{BD 151} : RD 151 := {}.
-Instance LtR151 `{LD 151} : TD 151 := {}.
-Instance RtR151 `{RD 151} : TD 151 := {}.
-Instance Ttb151 `{TD 151} : BD (S 151) := {}.
-
-Instance BtL152 `{BD 152} : LD 152 := {}.
-Instance BtR152 `{BD 152} : RD 152 := {}.
-Instance LtR152 `{LD 152} : TD 152 := {}.
-Instance RtR152 `{RD 152} : TD 152 := {}.
-Instance Ttb152 `{TD 152} : BD (S 152) := {}.
-
-Instance BtL153 `{BD 153} : LD 153 := {}.
-Instance BtR153 `{BD 153} : RD 153 := {}.
-Instance LtR153 `{LD 153} : TD 153 := {}.
-Instance RtR153 `{RD 153} : TD 153 := {}.
-Instance Ttb153 `{TD 153} : BD (S 153) := {}.
-
-Instance BtL154 `{BD 154} : LD 154 := {}.
-Instance BtR154 `{BD 154} : RD 154 := {}.
-Instance LtR154 `{LD 154} : TD 154 := {}.
-Instance RtR154 `{RD 154} : TD 154 := {}.
-Instance Ttb154 `{TD 154} : BD (S 154) := {}.
-
-Instance BtL155 `{BD 155} : LD 155 := {}.
-Instance BtR155 `{BD 155} : RD 155 := {}.
-Instance LtR155 `{LD 155} : TD 155 := {}.
-Instance RtR155 `{RD 155} : TD 155 := {}.
-Instance Ttb155 `{TD 155} : BD (S 155) := {}.
-
-Instance BtL156 `{BD 156} : LD 156 := {}.
-Instance BtR156 `{BD 156} : RD 156 := {}.
-Instance LtR156 `{LD 156} : TD 156 := {}.
-Instance RtR156 `{RD 156} : TD 156 := {}.
-Instance Ttb156 `{TD 156} : BD (S 156) := {}.
-
-Instance BtL157 `{BD 157} : LD 157 := {}.
-Instance BtR157 `{BD 157} : RD 157 := {}.
-Instance LtR157 `{LD 157} : TD 157 := {}.
-Instance RtR157 `{RD 157} : TD 157 := {}.
-Instance Ttb157 `{TD 157} : BD (S 157) := {}.
-
-Instance BtL158 `{BD 158} : LD 158 := {}.
-Instance BtR158 `{BD 158} : RD 158 := {}.
-Instance LtR158 `{LD 158} : TD 158 := {}.
-Instance RtR158 `{RD 158} : TD 158 := {}.
-Instance Ttb158 `{TD 158} : BD (S 158) := {}.
-
-Instance BtL159 `{BD 159} : LD 159 := {}.
-Instance BtR159 `{BD 159} : RD 159 := {}.
-Instance LtR159 `{LD 159} : TD 159 := {}.
-Instance RtR159 `{RD 159} : TD 159 := {}.
-Instance Ttb159 `{TD 159} : BD (S 159) := {}.
-
-Instance BtL160 `{BD 160} : LD 160 := {}.
-Instance BtR160 `{BD 160} : RD 160 := {}.
-Instance LtR160 `{LD 160} : TD 160 := {}.
-Instance RtR160 `{RD 160} : TD 160 := {}.
-Instance Ttb160 `{TD 160} : BD (S 160) := {}.
-
-Instance BtL161 `{BD 161} : LD 161 := {}.
-Instance BtR161 `{BD 161} : RD 161 := {}.
-Instance LtR161 `{LD 161} : TD 161 := {}.
-Instance RtR161 `{RD 161} : TD 161 := {}.
-Instance Ttb161 `{TD 161} : BD (S 161) := {}.
-
-Instance BtL162 `{BD 162} : LD 162 := {}.
-Instance BtR162 `{BD 162} : RD 162 := {}.
-Instance LtR162 `{LD 162} : TD 162 := {}.
-Instance RtR162 `{RD 162} : TD 162 := {}.
-Instance Ttb162 `{TD 162} : BD (S 162) := {}.
-
-Instance BtL163 `{BD 163} : LD 163 := {}.
-Instance BtR163 `{BD 163} : RD 163 := {}.
-Instance LtR163 `{LD 163} : TD 163 := {}.
-Instance RtR163 `{RD 163} : TD 163 := {}.
-Instance Ttb163 `{TD 163} : BD (S 163) := {}.
-
-Instance BtL164 `{BD 164} : LD 164 := {}.
-Instance BtR164 `{BD 164} : RD 164 := {}.
-Instance LtR164 `{LD 164} : TD 164 := {}.
-Instance RtR164 `{RD 164} : TD 164 := {}.
-Instance Ttb164 `{TD 164} : BD (S 164) := {}.
-
-Instance BtL165 `{BD 165} : LD 165 := {}.
-Instance BtR165 `{BD 165} : RD 165 := {}.
-Instance LtR165 `{LD 165} : TD 165 := {}.
-Instance RtR165 `{RD 165} : TD 165 := {}.
-Instance Ttb165 `{TD 165} : BD (S 165) := {}.
-
-Instance BtL166 `{BD 166} : LD 166 := {}.
-Instance BtR166 `{BD 166} : RD 166 := {}.
-Instance LtR166 `{LD 166} : TD 166 := {}.
-Instance RtR166 `{RD 166} : TD 166 := {}.
-Instance Ttb166 `{TD 166} : BD (S 166) := {}.
-
-Instance BtL167 `{BD 167} : LD 167 := {}.
-Instance BtR167 `{BD 167} : RD 167 := {}.
-Instance LtR167 `{LD 167} : TD 167 := {}.
-Instance RtR167 `{RD 167} : TD 167 := {}.
-Instance Ttb167 `{TD 167} : BD (S 167) := {}.
-
-Instance BtL168 `{BD 168} : LD 168 := {}.
-Instance BtR168 `{BD 168} : RD 168 := {}.
-Instance LtR168 `{LD 168} : TD 168 := {}.
-Instance RtR168 `{RD 168} : TD 168 := {}.
-Instance Ttb168 `{TD 168} : BD (S 168) := {}.
-
-Instance BtL169 `{BD 169} : LD 169 := {}.
-Instance BtR169 `{BD 169} : RD 169 := {}.
-Instance LtR169 `{LD 169} : TD 169 := {}.
-Instance RtR169 `{RD 169} : TD 169 := {}.
-Instance Ttb169 `{TD 169} : BD (S 169) := {}.
-
-Instance BtL170 `{BD 170} : LD 170 := {}.
-Instance BtR170 `{BD 170} : RD 170 := {}.
-Instance LtR170 `{LD 170} : TD 170 := {}.
-Instance RtR170 `{RD 170} : TD 170 := {}.
-Instance Ttb170 `{TD 170} : BD (S 170) := {}.
-
-Instance BtL171 `{BD 171} : LD 171 := {}.
-Instance BtR171 `{BD 171} : RD 171 := {}.
-Instance LtR171 `{LD 171} : TD 171 := {}.
-Instance RtR171 `{RD 171} : TD 171 := {}.
-Instance Ttb171 `{TD 171} : BD (S 171) := {}.
-
-Instance BtL172 `{BD 172} : LD 172 := {}.
-Instance BtR172 `{BD 172} : RD 172 := {}.
-Instance LtR172 `{LD 172} : TD 172 := {}.
-Instance RtR172 `{RD 172} : TD 172 := {}.
-Instance Ttb172 `{TD 172} : BD (S 172) := {}.
-
-Instance BtL173 `{BD 173} : LD 173 := {}.
-Instance BtR173 `{BD 173} : RD 173 := {}.
-Instance LtR173 `{LD 173} : TD 173 := {}.
-Instance RtR173 `{RD 173} : TD 173 := {}.
-Instance Ttb173 `{TD 173} : BD (S 173) := {}.
-
-Instance BtL174 `{BD 174} : LD 174 := {}.
-Instance BtR174 `{BD 174} : RD 174 := {}.
-Instance LtR174 `{LD 174} : TD 174 := {}.
-Instance RtR174 `{RD 174} : TD 174 := {}.
-Instance Ttb174 `{TD 174} : BD (S 174) := {}.
-
-Instance BtL175 `{BD 175} : LD 175 := {}.
-Instance BtR175 `{BD 175} : RD 175 := {}.
-Instance LtR175 `{LD 175} : TD 175 := {}.
-Instance RtR175 `{RD 175} : TD 175 := {}.
-Instance Ttb175 `{TD 175} : BD (S 175) := {}.
-
-Instance BtL176 `{BD 176} : LD 176 := {}.
-Instance BtR176 `{BD 176} : RD 176 := {}.
-Instance LtR176 `{LD 176} : TD 176 := {}.
-Instance RtR176 `{RD 176} : TD 176 := {}.
-Instance Ttb176 `{TD 176} : BD (S 176) := {}.
-
-Instance BtL177 `{BD 177} : LD 177 := {}.
-Instance BtR177 `{BD 177} : RD 177 := {}.
-Instance LtR177 `{LD 177} : TD 177 := {}.
-Instance RtR177 `{RD 177} : TD 177 := {}.
-Instance Ttb177 `{TD 177} : BD (S 177) := {}.
-
-Instance BtL178 `{BD 178} : LD 178 := {}.
-Instance BtR178 `{BD 178} : RD 178 := {}.
-Instance LtR178 `{LD 178} : TD 178 := {}.
-Instance RtR178 `{RD 178} : TD 178 := {}.
-Instance Ttb178 `{TD 178} : BD (S 178) := {}.
-
-Instance BtL179 `{BD 179} : LD 179 := {}.
-Instance BtR179 `{BD 179} : RD 179 := {}.
-Instance LtR179 `{LD 179} : TD 179 := {}.
-Instance RtR179 `{RD 179} : TD 179 := {}.
-Instance Ttb179 `{TD 179} : BD (S 179) := {}.
-
-Instance BtL180 `{BD 180} : LD 180 := {}.
-Instance BtR180 `{BD 180} : RD 180 := {}.
-Instance LtR180 `{LD 180} : TD 180 := {}.
-Instance RtR180 `{RD 180} : TD 180 := {}.
-Instance Ttb180 `{TD 180} : BD (S 180) := {}.
-
-Instance BtL181 `{BD 181} : LD 181 := {}.
-Instance BtR181 `{BD 181} : RD 181 := {}.
-Instance LtR181 `{LD 181} : TD 181 := {}.
-Instance RtR181 `{RD 181} : TD 181 := {}.
-Instance Ttb181 `{TD 181} : BD (S 181) := {}.
-
-Instance BtL182 `{BD 182} : LD 182 := {}.
-Instance BtR182 `{BD 182} : RD 182 := {}.
-Instance LtR182 `{LD 182} : TD 182 := {}.
-Instance RtR182 `{RD 182} : TD 182 := {}.
-Instance Ttb182 `{TD 182} : BD (S 182) := {}.
-
-Instance BtL183 `{BD 183} : LD 183 := {}.
-Instance BtR183 `{BD 183} : RD 183 := {}.
-Instance LtR183 `{LD 183} : TD 183 := {}.
-Instance RtR183 `{RD 183} : TD 183 := {}.
-Instance Ttb183 `{TD 183} : BD (S 183) := {}.
-
-Instance BtL184 `{BD 184} : LD 184 := {}.
-Instance BtR184 `{BD 184} : RD 184 := {}.
-Instance LtR184 `{LD 184} : TD 184 := {}.
-Instance RtR184 `{RD 184} : TD 184 := {}.
-Instance Ttb184 `{TD 184} : BD (S 184) := {}.
-
-Instance BtL185 `{BD 185} : LD 185 := {}.
-Instance BtR185 `{BD 185} : RD 185 := {}.
-Instance LtR185 `{LD 185} : TD 185 := {}.
-Instance RtR185 `{RD 185} : TD 185 := {}.
-Instance Ttb185 `{TD 185} : BD (S 185) := {}.
-
-Instance BtL186 `{BD 186} : LD 186 := {}.
-Instance BtR186 `{BD 186} : RD 186 := {}.
-Instance LtR186 `{LD 186} : TD 186 := {}.
-Instance RtR186 `{RD 186} : TD 186 := {}.
-Instance Ttb186 `{TD 186} : BD (S 186) := {}.
-
-Instance BtL187 `{BD 187} : LD 187 := {}.
-Instance BtR187 `{BD 187} : RD 187 := {}.
-Instance LtR187 `{LD 187} : TD 187 := {}.
-Instance RtR187 `{RD 187} : TD 187 := {}.
-Instance Ttb187 `{TD 187} : BD (S 187) := {}.
-
-Instance BtL188 `{BD 188} : LD 188 := {}.
-Instance BtR188 `{BD 188} : RD 188 := {}.
-Instance LtR188 `{LD 188} : TD 188 := {}.
-Instance RtR188 `{RD 188} : TD 188 := {}.
-Instance Ttb188 `{TD 188} : BD (S 188) := {}.
-
-Instance BtL189 `{BD 189} : LD 189 := {}.
-Instance BtR189 `{BD 189} : RD 189 := {}.
-Instance LtR189 `{LD 189} : TD 189 := {}.
-Instance RtR189 `{RD 189} : TD 189 := {}.
-Instance Ttb189 `{TD 189} : BD (S 189) := {}.
-
-Instance BtL190 `{BD 190} : LD 190 := {}.
-Instance BtR190 `{BD 190} : RD 190 := {}.
-Instance LtR190 `{LD 190} : TD 190 := {}.
-Instance RtR190 `{RD 190} : TD 190 := {}.
-Instance Ttb190 `{TD 190} : BD (S 190) := {}.
-
-Instance BtL191 `{BD 191} : LD 191 := {}.
-Instance BtR191 `{BD 191} : RD 191 := {}.
-Instance LtR191 `{LD 191} : TD 191 := {}.
-Instance RtR191 `{RD 191} : TD 191 := {}.
-Instance Ttb191 `{TD 191} : BD (S 191) := {}.
-
-Instance BtL192 `{BD 192} : LD 192 := {}.
-Instance BtR192 `{BD 192} : RD 192 := {}.
-Instance LtR192 `{LD 192} : TD 192 := {}.
-Instance RtR192 `{RD 192} : TD 192 := {}.
-Instance Ttb192 `{TD 192} : BD (S 192) := {}.
-
-Instance BtL193 `{BD 193} : LD 193 := {}.
-Instance BtR193 `{BD 193} : RD 193 := {}.
-Instance LtR193 `{LD 193} : TD 193 := {}.
-Instance RtR193 `{RD 193} : TD 193 := {}.
-Instance Ttb193 `{TD 193} : BD (S 193) := {}.
-
-Instance BtL194 `{BD 194} : LD 194 := {}.
-Instance BtR194 `{BD 194} : RD 194 := {}.
-Instance LtR194 `{LD 194} : TD 194 := {}.
-Instance RtR194 `{RD 194} : TD 194 := {}.
-Instance Ttb194 `{TD 194} : BD (S 194) := {}.
-
-Instance BtL195 `{BD 195} : LD 195 := {}.
-Instance BtR195 `{BD 195} : RD 195 := {}.
-Instance LtR195 `{LD 195} : TD 195 := {}.
-Instance RtR195 `{RD 195} : TD 195 := {}.
-Instance Ttb195 `{TD 195} : BD (S 195) := {}.
-
-Instance BtL196 `{BD 196} : LD 196 := {}.
-Instance BtR196 `{BD 196} : RD 196 := {}.
-Instance LtR196 `{LD 196} : TD 196 := {}.
-Instance RtR196 `{RD 196} : TD 196 := {}.
-Instance Ttb196 `{TD 196} : BD (S 196) := {}.
-
-Instance BtL197 `{BD 197} : LD 197 := {}.
-Instance BtR197 `{BD 197} : RD 197 := {}.
-Instance LtR197 `{LD 197} : TD 197 := {}.
-Instance RtR197 `{RD 197} : TD 197 := {}.
-Instance Ttb197 `{TD 197} : BD (S 197) := {}.
-
-Instance BtL198 `{BD 198} : LD 198 := {}.
-Instance BtR198 `{BD 198} : RD 198 := {}.
-Instance LtR198 `{LD 198} : TD 198 := {}.
-Instance RtR198 `{RD 198} : TD 198 := {}.
-Instance Ttb198 `{TD 198} : BD (S 198) := {}.
-
-Instance BtL199 `{BD 199} : LD 199 := {}.
-Instance BtR199 `{BD 199} : RD 199 := {}.
-Instance LtR199 `{LD 199} : TD 199 := {}.
-Instance RtR199 `{RD 199} : TD 199 := {}.
-Instance Ttb199 `{TD 199} : BD (S 199) := {}.
-
-(* Time Instance TestBD11 : BD 11 := _. *)
-(* Time Instance TestBD101 : BD 101 := _. *)
-Time Instance TestBD200 : BD 200 := _.
diff --git a/apps/tc-tabled/theories/dune b/apps/tc-tabled/theories/dune
new file mode 100644
index 000000000..0b9184e13
--- /dev/null
+++ b/apps/tc-tabled/theories/dune
@@ -0,0 +1,8 @@
+(coq.theory
+ (name elpi.apps.tc_tabled)
+ (package rocq-elpi)
+ (theories elpi elpi.apps.tc)
+ (flags -w -all -w -elpi)
+ (plugins rocq-elpi.tc ))
+
+(include_subdirs qualified)
diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index 4002c5ce6..799a28630 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -283,13 +283,11 @@ Elpi Accumulate lp:{{
       (synth GeneratorStack NewResumeStack NewAssertionTable NewRootAnswer) :-
     /* for each solution to g, push new cnode onto resume stack with it */
     std.map.find Goal AssertionTable (entry Waiters Answers),
-    /* add new cnode to g's dependents */
-    NewAnswers = [ Answer | Answers ],
     /* for each solution to g, push new cnode onto resume stack with it */
     std.fold Waiters (pr ResumeStack RootAnswer) (waiter_fun Answer Goal) (pr NewResumeStack NewRootAnswer),
     /* add new cnode to g's dependents */
     /* std.map.remove Goal AssertionTable TempAssertionTable, */
-    std.map.add Goal (entry Waiters NewAnswers) AssertionTable NewAssertionTable,
+    std.map.add Goal (entry Waiters [ Answer | Answers ]) AssertionTable NewAssertionTable,
     !.
 
   new_consumer_node

From c32d086febd5878dc60f845e265696ad091a9e26 Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Tue, 12 Aug 2025 11:35:15 +0200
Subject: [PATCH 12/23] Working tabled type check tests (is slow..)

---
 apps/tc-tabled/theories/diamond.v           | 80 +++++++++++++++------
 apps/tc-tabled/theories/tabled_type_class.v | 35 +--------
 2 files changed, 59 insertions(+), 56 deletions(-)

diff --git a/apps/tc-tabled/theories/diamond.v b/apps/tc-tabled/theories/diamond.v
index 9f6566d32..7cf1b2827 100644
--- a/apps/tc-tabled/theories/diamond.v
+++ b/apps/tc-tabled/theories/diamond.v
@@ -1,11 +1,3 @@
-From elpi.apps.tc_tabled Require Import tabled_type_class.
-
-(* Diamond example in Rocq *)
-Elpi TC Solver Activate TC.TabledSolver.
-Elpi TC Solver Override TC.TabledSolver All.
-
-Elpi Export TC.TabledSolver.
-
 Class T (alpha : Type) (n : nat).
 Class R (alpha : Type) (n : nat).
 Class L (alpha : Type) (n : nat).
@@ -18,6 +10,7 @@ Instance TtR alpha n `{T alpha n} : B alpha (S n) := {}.
 
 Instance B0 alpha : B alpha 0 := {}.
 
+(* Tabled: Finished transaction in 49.593 secs (49.415u,0.117s) (successful) *)
 (* Rocq: Finished transaction in 0.151 secs (0.151u,0.s) (successful) *)
 Module Test100. Time Instance TtR100 : B unit 100 := _. End Test100.
 
@@ -30,25 +23,66 @@ Module Test300. Time Instance TtR300 : B unit 300 := _. End Test300.
 (* Rocq: Finished transaction in 12.245 secs (11.568u,0.091s) (successful) *)
 Module Test400. Time Instance TtR400 : B unit 400 := _. End Test400.
 
-(* Rocq: Finished transaction in 23.508 secs (22.228u,0.258s) (successful) *)
-Module Test500. Time Instance TtR500 : B unit 500 := _. End Test500.
+(* (* (* Rocq: Finished transaction in 23.508 secs (22.228u,0.258s) (successful) *) *) *)
+(* (* Module Test500. Time Instance TtR500 : B unit 500 := _. End Test500. *) *)
+
+(* (* (* Rocq: Finished transaction in 37.784 secs (37.582u,0.059s) (successful) *) *) *)
+(* (* Module Test600. Time Instance TtR600 : B unit 600 := _. End Test600. *) *)
+
+(* (* (* Rocq: Finished transaction in 66.476 secs (66.261u,0.106s) (successful) *) *) *)
+(* (* Module Test700. Time Instance TtR700 : B unit 700 := _. End Test700. *) *)
+
+(* (* (* Rocq: Finished transaction in 77.99 secs (77.174u,0.11s) (successful) *) *) *)
+(* (* Module Test800. Time Instance TtR800 : B unit 800 := _. End Test800. *) *)
+
+(* (* (* Rocq: Finished transaction in 106.952 secs (106.779u,0.025s) (successful) *) *) *)
+(* (* Module Test900. Time Instance TtR900 : B unit 900 := _. End Test900. *) *)
+
+(* (* (* Rocq: Finished transaction in 184.144 secs (183.71u,0.117s) (successful) *) *) *)
+(* (* Module Test1000. Time Instance TtR1000 : B unit 1000 := _. End Test1000. *) *)
+
+(* (* (* Ratio: ~ time: 2^(x/100) secs *) *) *)
+
+(* (* (* Rocq: Finished transaction in 1476.371 secs (1463.871u,3.989s) (successful) *) *) *)
+(* (* Module Test2000. Time Instance TtR2000 : B unit 2000 := _. End Test2000. *) *)
+
+From elpi Require Import elpi.
+From elpi.apps Require Import tc.
+
+(* Elpi TC Solver Activate TC.Solver. *)
+Elpi TC Solver Override TC.Solver All.
+
+TC.AddAllClasses.
+TC.AddAllInstances.
+
+(* TC: Finished transaction in 0.124 secs (0.122u,0.001s) (successful) *)
+Module Test100TC. Time Instance TtR100 : B unit 100 := _. End Test100TC.
+
+(* TC: Finished transaction in 0.313 secs (0.309u,0.003s) (successful) *)
+Module Test200TC. Time Instance TtR200 : B unit 200 := _. End Test200TC.
+
+(* TC: Finished transaction in 0.636 secs (0.629u,0.006s) (successful) *)
+Module Test300TC. Time Instance TtR300 : B unit 300 := _. End Test300TC.
+
+(* TC: Finished transaction in 1.082 secs (1.061u,0.02s) (successful) *)
+Module Test400TC. Time Instance TtR400 : B unit 400 := _. End Test400TC.
+
+Elpi TC Solver Override TC.Solver None.
+
+From elpi.apps.tc_tabled Require Import tabled_type_class.
+
+(* Diamond example in Rocq *)
+Elpi TC Solver Activate TC.TabledSolver.
+Elpi TC Solver Override TC.TabledSolver All.
 
-(* Rocq: Finished transaction in 37.784 secs (37.582u,0.059s) (successful) *)
-Module Test600. Time Instance TtR600 : B unit 600 := _. End Test600.
+(* Tabled: Finished transaction in 49.593 secs (49.415u,0.117s) (successful) *)
+Module Test100Tabled. Time Instance TtR100 : B unit 100 := _. End Test100Tabled.
 
-(* Rocq: Finished transaction in 66.476 secs (66.261u,0.106s) (successful) *)
-Module Test700. Time Instance TtR700 : B unit 700 := _. End Test700.
 
-(* Rocq: Finished transaction in 77.99 secs (77.174u,0.11s) (successful) *)
-Module Test800. Time Instance TtR800 : B unit 800 := _. End Test800.
+(* Module Test200Tabled. Time Instance TtR200 : B unit 200 := _. End Test200Tabled. *)
 
-(* Rocq: Finished transaction in 106.952 secs (106.779u,0.025s) (successful) *)
-Module Test900. Time Instance TtR900 : B unit 900 := _. End Test900.
 
-(* Rocq: Finished transaction in 184.144 secs (183.71u,0.117s) (successful) *)
-Module Test1000. Time Instance TtR1000 : B unit 1000 := _. End Test1000.
+(* Module Test300Tabled. Time Instance TtR300 : B unit 300 := _. End Test300Tabled. *)
 
-(* Ratio: ~ time: 2^(x/100) secs *)
 
-(* Rocq: Finished transaction in 1476.371 secs (1463.871u,3.989s) (successful) *)
-Module Test2000. Time Instance TtR2000 : B unit 2000 := _. End Test2000.
+(* Module Test400Tabled. Time Instance TtR400 : B unit 400 := _. End Test400Tabled. *)
diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index 799a28630..de8cdf193 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -490,40 +490,9 @@ Elpi Accumulate lp:{{
   solve _ _ :- coq.ltac.fail _ "No auto".
 }}.
 
+(*
 Elpi TC Solver Activate TC.TabledSolver.
 Elpi TC Solver Override TC.TabledSolver All.
+ *)
 
 Elpi Export TC.TabledSolver.
-
-(* Partial Simple Diamond example *)
-Class T (n : nat).
-Class R (n : nat).
-Class L (n : nat).
-Class B (n : nat).
-Instance BtL n `{B n} : L n := {}.
-Instance BtR n `{B n} : R n := {}.
-Instance LtR n `{L n} : T n := {}.
-Instance RtR n `{R n} : T n := {}.
-Instance Ttb n `{T n} : B (S n) := {}.
-
-Instance B0 : B 0 := {}.
-
-(* Instance Test0 : B 0 := _. *)
-(* Instance Test1 : B 1 := _. *)
-(* Instance Test2 : B 2 := _. *)
-(* Instance Test5 : B 5 := _. *)
-
-(* 0.096 secs *)
-(* Time Instance Test10 : B 10 := _. *)
-
-(* 0.413 secs *)
-(* Time Instance Test20 : B 20 := _. *)
-
-(* 88.014 secs *)
-(* Time Instance Test100 : B 100 := _. *)
-
-(* 1176.986 secs *)
-(* Time Instance Test200 : B 200 := _. *)
-
-(* Time Instance Test500 : B 500 := _. *)
-(* Time Instance Test1000 : B 1000 := _. *)

From 8f1fabefc881a0d22043aedd9151bf469baebce1 Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Tue, 12 Aug 2025 16:30:34 +0200
Subject: [PATCH 13/23] Experimenting with different map

---
 apps/tc-tabled/theories/diamond.v           | 19 +++--
 apps/tc-tabled/theories/tabled_type_class.v | 90 +++++++++++++++++----
 2 files changed, 85 insertions(+), 24 deletions(-)

diff --git a/apps/tc-tabled/theories/diamond.v b/apps/tc-tabled/theories/diamond.v
index 7cf1b2827..e92411e8e 100644
--- a/apps/tc-tabled/theories/diamond.v
+++ b/apps/tc-tabled/theories/diamond.v
@@ -1,3 +1,6 @@
+(* https://github.com/leanprover/lean4/blob/master/tests/lean/run/typeclass_diamond.lean *)
+
+(* Diamond *)
 Class T (alpha : Type) (n : nat).
 Class R (alpha : Type) (n : nat).
 Class L (alpha : Type) (n : nat).
@@ -17,11 +20,11 @@ Module Test100. Time Instance TtR100 : B unit 100 := _. End Test100.
 (* Rocq: Finished transaction in 1.372 secs (1.195u,0.03s) (successful) *)
 Module Test200. Time Instance TtR200 : B unit 200 := _. End Test200.
 
-(* Rocq: Finished transaction in 4.842 secs (4.084u,0.147s) (successful) *)
-Module Test300. Time Instance TtR300 : B unit 300 := _. End Test300.
+(* (* Rocq: Finished transaction in 4.842 secs (4.084u,0.147s) (successful) *) *)
+(* Module Test300. Time Instance TtR300 : B unit 300 := _. End Test300. *)
 
-(* Rocq: Finished transaction in 12.245 secs (11.568u,0.091s) (successful) *)
-Module Test400. Time Instance TtR400 : B unit 400 := _. End Test400.
+(* (* Rocq: Finished transaction in 12.245 secs (11.568u,0.091s) (successful) *) *)
+(* Module Test400. Time Instance TtR400 : B unit 400 := _. End Test400. *)
 
 (* (* (* Rocq: Finished transaction in 23.508 secs (22.228u,0.258s) (successful) *) *) *)
 (* (* Module Test500. Time Instance TtR500 : B unit 500 := _. End Test500. *) *)
@@ -75,14 +78,14 @@ From elpi.apps.tc_tabled Require Import tabled_type_class.
 Elpi TC Solver Activate TC.TabledSolver.
 Elpi TC Solver Override TC.TabledSolver All.
 
-(* Tabled: Finished transaction in 49.593 secs (49.415u,0.117s) (successful) *)
-Module Test100Tabled. Time Instance TtR100 : B unit 100 := _. End Test100Tabled.
+Module Test20Tabled. Time Instance TtR20 : B unit 20 := _. End Test20Tabled.
 
+(* (* Finished transaction in 55.794 secs (55.684u,0.097s) (successful) *) *)
+(* Module Test100Tabled. Time Instance TtR100 : B unit 100 := _. End Test100Tabled. *)
 
+(* (* Finished transaction in 737.925 secs (736.366u,0.837s) (successful) *) *)
 (* Module Test200Tabled. Time Instance TtR200 : B unit 200 := _. End Test200Tabled. *)
 
-
 (* Module Test300Tabled. Time Instance TtR300 : B unit 300 := _. End Test300Tabled. *)
 
-
 (* Module Test400Tabled. Time Instance TtR400 : B unit 400 := _. End Test400Tabled. *)
diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index de8cdf193..c18eae6de 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -1,9 +1,70 @@
 From elpi Require Import elpi.
 From elpi.apps Require Import tc.
 
-#[arguments(raw)] Elpi Tactic TC.TabledSolver.
+Elpi Tactic TC.TabledSolver.
 Elpi TC Solver Register TC.TabledSolver.
 
+Elpi Accumulate lp:{{
+pred binary_search i:K i:(pred i:K i:K o:cmp) i:int i:int i:list K o:int o:bool.
+binary_search A Cmp L R XS Out Approx :-
+  if (le_ L R)
+   	(M is L + ((R - L) div 2),
+   	std.nth M XS X,
+   	Cmp X A C,
+   	if (C = lt)
+ 	     (binary_search A Cmp (M + 1) R XS Out Approx)
+ 	     (if (C = gt)
+ 	         (binary_search A Cmp L (M - 1) XS Out Approx)
+ 	         (Out is M, Approx = ff)))
+ 	  (Out is L, Approx = tt)
+  , !.
+}}.
+
+Elpi Accumulate lp:{{
+kind mymap type -> type -> type.
+type mymap list (pair K V) -> (pred i:K i:K o:cmp) -> mymap K V.
+
+% [make Eq Ltn M] builds an empty map M where keys are compared using Eq and Ltn
+pred make i:(pred i:K, i:K, o:cmp), o:mymap K V.
+make Cmp (mymap [] Cmp).
+
+pred cmp_fst_pair i:(pred i:K i:K o:cmp) i:pair K V i:pair K V o:cmp.
+cmp_fst_pair Cmp (pr K1 _) (pr K2 _) C :- Cmp K1 K2 C.
+
+% [find K M V] looks in M for the value V associated to K
+pred find i:K, i:mymap K V, o:V.
+find K (mymap M Cmp) V :-
+  std.length M Len,
+  binary_search (pr K V) (cmp_fst_pair Cmp) 0 (Len - 1) M I ff,
+  std.nth I M (pr KK V),
+  Cmp KK K eq,
+  !.
+
+% [add K V M M1] M1 is M where K is bound to V
+pred add i:K, i:V, i:mymap K V, o:mymap K V.
+add K V (mymap M Cmp) (mymap M1 Cmp) :-
+  std.length M Len,
+  coq.say "Search",
+  binary_search (pr K V) (cmp_fst_pair Cmp) 0 (Len - 1) M I Approx,
+  std.split-at I M F T,
+  if (Approx = tt)
+     (coq.say "Insert", std.append F [ (pr K V) | T  ] M1) /* insert */
+     (coq.say "Update", T = [ pr KK _ | VS ] , Cmp KK K eq , std.append F [ (pr K V) | VS ] M1) /* update */
+  , coq.say "Done"
+  , !.
+}}.
+
+Elpi Query lp:{{
+  make cmp_term MyMap,
+  coq.say "Empty:" MyMap,
+  add "hello" "24" MyMap UpdatedMap,
+  coq.say "updated map" UpdatedMap,
+  add "hello2" "28" UpdatedMap MoreUpdatedMap,
+  find "hello" MoreUpdatedMap Result.
+}}.
+
+(* https://github.com/leanprover/lean4/blob/cade21/src/Lean/Meta/SynthInstance.lean *)
+(* https://github.com/LPCIC/coq-elpi/blob/master/builtin-doc/coq-builtin.elpi *)
 (* Tabled type class : https://github.com/purefunctor/tabled-typeclass-resolution?tab=readme-ov-file *)
 (* https://github.com/purefunctor/tabled-typeclass-resolution/blob/main/src/lib.rs *)
 (* ty = https://github.com/leanprover/lean4/blob/cade21/src/Lean/Expr.lean#L152-L165 *)
@@ -33,7 +94,7 @@ Elpi Accumulate lp:{{
   typeabbrev instance tc-instance.
 
   kind class_instances type.
-  type class_instances std.map assertion (list instance) -> class_instances.
+  type class_instances mymap assertion (list instance) -> class_instances.
 
   kind generator_node type.
   type generator_node assertion -> list instance -> generator_node.
@@ -41,7 +102,7 @@ Elpi Accumulate lp:{{
   kind synth type.
   type synth list generator_node ->
     resume_stack ->
-    std.map assertion entry ->
+    mymap assertion entry ->
     option assertion ->
     synth.
 }}.
@@ -90,7 +151,7 @@ Elpi Accumulate lp:{{
     (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
     Subgoal Waiter
     (synth NewGeneratorStack ResumeStack NewAssertionTable RootAnswer) :-
-    std.map.add Subgoal (entry [Waiter] []) AssertionTable NewAssertionTable,
+    add Subgoal (entry [Waiter] []) AssertionTable NewAssertionTable,
     assertion_typeclass Subgoal Name,
     coq.TC.db-for Name Instances,
     NewGeneratorStack = [(generator_node Subgoal Instances) | GeneratorStack]
@@ -282,12 +343,14 @@ Elpi Accumulate lp:{{
       (consumer_node Goal [])
       (synth GeneratorStack NewResumeStack NewAssertionTable NewRootAnswer) :-
     /* for each solution to g, push new cnode onto resume stack with it */
-    std.map.find Goal AssertionTable (entry Waiters Answers),
+    find Goal AssertionTable (entry Waiters Answers),
     /* for each solution to g, push new cnode onto resume stack with it */
     std.fold Waiters (pr ResumeStack RootAnswer) (waiter_fun Answer Goal) (pr NewResumeStack NewRootAnswer),
     /* add new cnode to g's dependents */
     /* std.map.remove Goal AssertionTable TempAssertionTable, */
-    std.map.add Goal (entry Waiters [ Answer | Answers ]) AssertionTable NewAssertionTable,
+    coq.say "Add",
+    add Goal (entry Waiters [ Answer | Answers ]) AssertionTable NewAssertionTable,
+    coq.say "Done",
     !.
 
   new_consumer_node
@@ -296,7 +359,7 @@ Elpi Accumulate lp:{{
       (consumer_node _ [ Subgoal | _ ] as CN)
       (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer) :-
       /* TODO: Consumer node is general instead of variable or hole */
-      if (std.map.find Subgoal AssertionTable (entry Waiters Answers))
+      if (find Subgoal AssertionTable (entry Waiters Answers))
          (
           /* Map answers with consumer node */
           /* Add cnode onto G's dependents? */
@@ -304,8 +367,8 @@ Elpi Accumulate lp:{{
           std.append TempResumeStack ResumeStack NewResumeStack,
 
           NewWaiters = [ callback CN | Waiters ],
-          std.map.remove Subgoal AssertionTable TempAssertionTable,
-          std.map.add Subgoal (entry NewWaiters Answers) TempAssertionTable NewAssertionTable,
+              /* std.map.remove Subgoal AssertionTable TempAssertionTable, */
+          add Subgoal (entry NewWaiters Answers) AssertionTable NewAssertionTable,
           NewGeneratorStack = GeneratorStack
          )
          (
@@ -393,7 +456,7 @@ Elpi Accumulate lp:{{
 
   pred tabled_typeclass_resolution i:assertion o:assertion.
   tabled_typeclass_resolution Query FinalAnswer :-
-    std.map.make assertion_equal AssertionTableEmpty,
+    make assertion_equal AssertionTableEmpty,
     new_subgoal (synth [] [] AssertionTableEmpty none) Query root MySynth,
     /* while true do */
     synth_loop MySynth Query 20000 FinalAnswer,
@@ -418,7 +481,7 @@ Elpi Query lp:{{
 
 (* Instance TestRAB : R1 A1 B1 := _. *)
 
-(* Example from Paper *)
+(* Example from Paper: Tabled Typeclass Resolution *)
 Elpi Query lp:{{
   MyGoal = {{ R1 A1 D1 }},
   coq.say "MyGoal" (assertion MyGoal {{ lib:elpi.hole }}),
@@ -432,11 +495,6 @@ Elpi Query lp:{{
   ground_term FinalAnswer.
 }}.
 
-(* https://github.com/leanprover/lean4/blob/cade21/src/Lean/Meta/SynthInstance.lean *)
-(* https://github.com/leanprover/lean4/blob/master/tests/lean/run/typeclass_diamond.lean *)
-(* Diamond *)
-
-(* https://github.com/LPCIC/coq-elpi/blob/master/builtin-doc/coq-builtin.elpi *)
 Elpi Accumulate lp:{{
   pred proof_search i:list gref i:list tc-instance i:term o:term.
   proof_search Typeclasses [tc-instance Hd _ | _ ] Type PRoof :-

From 295509083dc7bf6cfff9e821dd494f2e0d23d4a6 Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Tue, 12 Aug 2025 21:32:35 +0200
Subject: [PATCH 14/23] WIP

---
 apps/tc-tabled/theories/diamond.v           |   2 +-
 apps/tc-tabled/theories/tabled_type_class.v | 235 ++++++++++++++++++--
 2 files changed, 214 insertions(+), 23 deletions(-)

diff --git a/apps/tc-tabled/theories/diamond.v b/apps/tc-tabled/theories/diamond.v
index e92411e8e..0c550136c 100644
--- a/apps/tc-tabled/theories/diamond.v
+++ b/apps/tc-tabled/theories/diamond.v
@@ -78,7 +78,7 @@ From elpi.apps.tc_tabled Require Import tabled_type_class.
 Elpi TC Solver Activate TC.TabledSolver.
 Elpi TC Solver Override TC.TabledSolver All.
 
-Module Test20Tabled. Time Instance TtR20 : B unit 20 := _. End Test20Tabled.
+(* Module Test20Tabled. Time Instance TtR20 : B unit 20 := _. End Test20Tabled. *)
 
 (* (* Finished transaction in 55.794 secs (55.684u,0.097s) (successful) *) *)
 (* Module Test100Tabled. Time Instance TtR100 : B unit 100 := _. End Test100Tabled. *)
diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index c18eae6de..e5b9b07b6 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -6,20 +6,179 @@ Elpi TC Solver Register TC.TabledSolver.
 
 Elpi Accumulate lp:{{
 pred binary_search i:K i:(pred i:K i:K o:cmp) i:int i:int i:list K o:int o:bool.
+/* binary_search A Cmp L R [ X | XS ] Out Approx :-
+  /* Linear search .. */
+  if (Cmp X A lt)
+     (binary_search A Cmp (L + 1) R XS Out Approx)
+     (Out is L,
+      if (Cmp X A eq)
+         (Approx = ff)
+         (Approx = tt))
+  , !.
+binary_search A Cmp L _ [] Out Approx :-
+!, Approx = tt, Out is L. */
 binary_search A Cmp L R XS Out Approx :-
   if (le_ L R)
    	(M is L + ((R - L) div 2),
    	std.nth M XS X,
    	Cmp X A C,
+    !,
    	if (C = lt)
- 	     (binary_search A Cmp (M + 1) R XS Out Approx)
+ 	     (!, binary_search A Cmp (M + 1) R XS Out Approx)
  	     (if (C = gt)
- 	         (binary_search A Cmp L (M - 1) XS Out Approx)
- 	         (Out is M, Approx = ff)))
+ 	         (!, binary_search A Cmp L (M - 1) XS Out Approx)
+ 	         (!, Out is M, Approx = ff)))
  	  (Out is L, Approx = tt)
-  , !.
+    , !.
+}}.
+
+Elpi Accumulate lp:{{
+kind std.map2 type -> type -> type.
+type std.map2 std.map2.private.map K V -> (pred i:K, i:K, o:cmp) -> std.map2 K V.
+
+namespace std.map2 {
+
+% [make Eq Ltn M] builds an empty map M where keys are compared using Eq and Ltn
+pred make i:(pred i:K, i:K, o:cmp), o:std.map2 K V.
+make Cmp (std.map2 private.empty Cmp).
+
+
+% [find K M V] looks in M for the value V associated to K
+pred find i:K, i:std.map2 K V, o:V.
+find K (std.map2 M Cmp) V :- 
+  coq.say "Find",
+  private.find M Cmp K V,
+  coq.say "FY".
+find _ _ _ :- coq.say "FN", fail.
+
+% [add K V M M1] M1 is M where K is bound to V
+pred add i:K, i:V, i:std.map2 K V, o:std.map2 K V.
+add K V (std.map2 M Cmp) (std.map2 M1 Cmp) :- 
+  private.add M Cmp K V M1.
+
+% [update K V M M1] M1 is M where K is bound to V
+pred update i:K, i:V, i:std.map2 K V, o:std.map2 K V.
+update K V (std.map2 M Cmp) (std.map2 M1 Cmp) :- 
+  private.update M Cmp K V M1.
+
+% [remove K M M1] M1 is M where K is unbound
+pred remove i:K, i:std.map2 K V, o:std.map2 K V.
+remove K (std.map2 M Cmp) (std.map2 M1 Cmp) :- private.remove M Cmp K M1.
+
+% [bindings M L] L is the key-value pairs in increasing order
+pred bindings i:std.map2 K V, o:list (pair K V).
+bindings (std.map2 M _) L :- private.bindings M [] L.
+
+namespace private {
+
+% Taken from OCaml's map.ml
+kind map type -> type -> type.
+type empty map K V.
+type node map K V -> K -> V -> map K V -> int -> map K V.
+
+pred height i:map K V, o:int.
+height empty 0.
+height (node _ _ _ _ H) H.
+
+pred create i:map K V, i:K, i:V, i:map K V, o:map K V.
+create L K V R (node L K V R H) :- H is {std.max {height L} {height R} } + 1.
+
+pred print_m i:(map K V) o:string.
+print_m (empty) "emtpy". 
+print_m (node L _ _ R I) S :-
+  print_m L SL,
+  print_m R SR,
+  S is "(" ^ SL ^ "," ^ "," ^ SR ^ ")"
+  .
+
+pred bal i:map K V, i:K, i:V, i:map K V, o:map K V.
+bal L K V R T :-
+  height L HL,
+  height R HR,
+  HL2 is HL + 2,
+  HR2 is HR + 2,
+  bal.aux HL HR HL2 HR2 L K V R T.
+
+pred bal.aux i:int, i:int, i:int, i:int, i:map K V, i:K, i:V, i:map K V, o:map K V.
+bal.aux HL _ _ HR2 (node LL LV LD LR _) X D R T :-
+  HL > HR2, {height LL} >= {height LR}, !,
+  create LL LV LD {create LR X D R} T.
+bal.aux HL _ _ HR2 (node LL LV LD (node LRL LRV LRD LRR _) _) X D R T :-
+  HL > HR2, !,
+  create {create LL LV LD LRL} LRV LRD {create LRR X D R} T.
+bal.aux _ HR HL2 _ L X D (node RL RV RD RR _) T :-
+  HR > HL2, {height RR} >= {height RL}, !,
+  create {create L X D RL} RV RD RR T.
+bal.aux _ HR HL2 _ L X D (node (node RLL RLV RLD RLR _) RV RD RR _) T :-
+  HR > HL2, !,
+  create {create L X D RLL} RLV RLD {create RLR RV RD RR} T.
+bal.aux _ _ _ _ L K V R T :- create L K V R T.
+
+pred add i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
+add empty _ K V T :- create empty K V empty T.
+add (node _ X _ _ _ as M) Cmp X1 XD M1 :- Cmp X1 X E, !, add.aux E M Cmp X1 XD M1.
+
+pred add.aux i:cmp, i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
+add.aux eq (node L _ _ R H) _   X XD T :- T = node L X XD R H, !. 
+add.aux lt (node L V D R _) Cmp X XD T :- bal {add L Cmp X XD} V D R T, !.
+add.aux gt (node L V D R _) Cmp X XD T :- bal L V D {add R Cmp X XD} T, !.
+
+pred update i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
+update (node _ X _ _ _ as M) Cmp X1 XD M1 :- 
+  !, Cmp X1 X E, !, update.aux E M Cmp X1 XD M1, !.
+
+pred update.aux i:cmp, i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
+update.aux eq (node L _ _ R H) _   X XD T :- 
+  T = node L X XD R H, !. 
+update.aux lt (node L V D R H) Cmp X XD T :- 
+  T = node {update L Cmp X XD} V D R H, !.
+update.aux gt (node L V D R H) Cmp X XD T :- 
+  T = node L V D {update R Cmp X XD} H, !.
+
+pred find i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:V.
+find ((node L K1 V1 R _) as M) Cmp K V :- 
+  Cmp K K1 E, find.aux E Cmp L R V1 K V.
+
+pred find.aux i:cmp, i:(pred i:K, i:K, o:cmp), i:map K V, i:map K V, i:V, i:K, o:V.
+find.aux eq _   _ _ V _ V.
+find.aux lt Cmp L _ _ K V :- find L Cmp K V.
+find.aux gt Cmp _ R _ K V :- find R Cmp K V.
+
+pred remove-min-binding i:map K V, o:map K V.
+remove-min-binding (node empty _ _ R _) R :- !.
+remove-min-binding (node L V D R _) X :- bal {remove-min-binding L} V D R X.
+
+pred min-binding i:map K V, o:K, o:V.
+min-binding (node empty V D _ _) V D :- !.
+min-binding (node L _ _ _ _) V D :- min-binding L V D.
+
+pred merge i:map K V, i:map K V, o:map K V.
+merge empty X X :- !.
+merge X empty X :- !.
+merge M1 M2 R :-
+  min-binding M2 X D,
+  bal M1 X D {remove-min-binding M2} R.
+
+pred remove i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:map K V.
+remove empty _ _ empty :- !.
+remove (node L V D R _) Cmp X M :- Cmp X V E, remove.aux E Cmp L R V D X M.
+
+pred remove.aux i:cmp, i:(pred i:K, i:K, o:cmp), i:map K V, i:map K V, i:K, i:V, i:K, o:map K V.
+remove.aux eq _   L R _ _ _ M :- merge L R M.
+remove.aux lt Cmp L R V D X M :- bal {remove L Cmp X} V D R M.
+remove.aux gt Cmp L R V D X M :- bal L V D {remove R Cmp X} M.
+
+pred bindings i:map K V, i:list (pair K V), o:list (pair K V).
+bindings empty X X.
+bindings (node L V D R _) X X1 :-
+  bindings L [pr V D|{bindings R X}] X1.
+
+
+} % std.map2.private
+} % std.map2
 }}.
 
+(*
 Elpi Accumulate lp:{{
 kind mymap type -> type -> type.
 type mymap list (pair K V) -> (pred i:K i:K o:cmp) -> mymap K V.
@@ -34,22 +193,49 @@ cmp_fst_pair Cmp (pr K1 _) (pr K2 _) C :- Cmp K1 K2 C.
 % [find K M V] looks in M for the value V associated to K
 pred find i:K, i:mymap K V, o:V.
 find K (mymap M Cmp) V :-
+  coq.say "Find",
   std.length M Len,
-  binary_search (pr K V) (cmp_fst_pair Cmp) 0 (Len - 1) M I ff,
+  binary_search (pr K (_ /* dummy value */)) (cmp_fst_pair Cmp) 0 (Len - 1) M I ff,
+  !,
   std.nth I M (pr KK V),
   Cmp KK K eq,
-  !.
+  !,
+  coq.say "FY".
+find _ _ _ :- coq.say "FN", fail.
+
+pred insert_index i:int i:V i:list V o:list V.
+insert_index I V L O :- /* std.append F [ (pr K VI) | T  ] M1 */
+  std.split-at I L F T,
+  !,
+  std.append F [ V | T ] O.
+/* insert_index 0 V L [ V | L ].
+insert_index N V [ X | L ] [ X | O ] :-
+  NN is N - 1,
+  insert_index NN V L O. */
+
+pred update_index i:int i:V i:list V o:list V.
+update_index I V L O :- /* T = [ pr KK _ | VS ] , Cmp KK K eq , std.append F [ (pr K VI) | VS ] M1 */
+  coq.say "split",
+  std.split-at I L F [ _ | T ],
+  !,
+  coq.say "append",
+  std.append F [ V | T ] O.
+/* update_index 0 V [ _ | L ] [ V | L ] :- !.
+update_index N V [ X | L ] [ X | O ] :-
+  NN is N - 1,
+  !,
+  update_index NN V L O,
+  !. */
 
 % [add K V M M1] M1 is M where K is bound to V
 pred add i:K, i:V, i:mymap K V, o:mymap K V.
 add K V (mymap M Cmp) (mymap M1 Cmp) :-
   std.length M Len,
   coq.say "Search",
-  binary_search (pr K V) (cmp_fst_pair Cmp) 0 (Len - 1) M I Approx,
-  std.split-at I M F T,
+  binary_search (pr K (_ /* dummy value */)) (cmp_fst_pair Cmp) 0 (Len - 1) M I Approx,
   if (Approx = tt)
-     (coq.say "Insert", std.append F [ (pr K V) | T  ] M1) /* insert */
-     (coq.say "Update", T = [ pr KK _ | VS ] , Cmp KK K eq , std.append F [ (pr K V) | VS ] M1) /* update */
+  (coq.say "Insert", insert_index I (pr K V) M M1) /* insert */
+  (coq.say "Update", update_index I (pr K V) M M1 ) /* update */
   , coq.say "Done"
   , !.
 }}.
@@ -62,6 +248,7 @@ Elpi Query lp:{{
   add "hello2" "28" UpdatedMap MoreUpdatedMap,
   find "hello" MoreUpdatedMap Result.
 }}.
+ *)
 
 (* https://github.com/leanprover/lean4/blob/cade21/src/Lean/Meta/SynthInstance.lean *)
 (* https://github.com/LPCIC/coq-elpi/blob/master/builtin-doc/coq-builtin.elpi *)
@@ -94,7 +281,7 @@ Elpi Accumulate lp:{{
   typeabbrev instance tc-instance.
 
   kind class_instances type.
-  type class_instances mymap assertion (list instance) -> class_instances.
+  type class_instances std.map2 assertion (list instance) -> class_instances.
 
   kind generator_node type.
   type generator_node assertion -> list instance -> generator_node.
@@ -102,7 +289,7 @@ Elpi Accumulate lp:{{
   kind synth type.
   type synth list generator_node ->
     resume_stack ->
-    mymap assertion entry ->
+    std.map2 assertion entry ->
     option assertion ->
     synth.
 }}.
@@ -130,6 +317,7 @@ Elpi Accumulate lp:{{
 
   pred assertion_equal i:assertion i:assertion o:cmp.
   assertion_equal (assertion A _) (assertion B _) Cmp :-
+  /* coq.say {coq.term->string A} "VS" {coq.term->string B}, */
     type_equal A B Cmp,
     !
     /* Deterministic ! */
@@ -151,7 +339,7 @@ Elpi Accumulate lp:{{
     (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
     Subgoal Waiter
     (synth NewGeneratorStack ResumeStack NewAssertionTable RootAnswer) :-
-    add Subgoal (entry [Waiter] []) AssertionTable NewAssertionTable,
+    std.map2.add Subgoal (entry [Waiter] []) AssertionTable NewAssertionTable,
     assertion_typeclass Subgoal Name,
     coq.TC.db-for Name Instances,
     NewGeneratorStack = [(generator_node Subgoal Instances) | GeneratorStack]
@@ -343,13 +531,12 @@ Elpi Accumulate lp:{{
       (consumer_node Goal [])
       (synth GeneratorStack NewResumeStack NewAssertionTable NewRootAnswer) :-
     /* for each solution to g, push new cnode onto resume stack with it */
-    find Goal AssertionTable (entry Waiters Answers),
+    std.map2.find Goal AssertionTable (entry Waiters Answers),
     /* for each solution to g, push new cnode onto resume stack with it */
     std.fold Waiters (pr ResumeStack RootAnswer) (waiter_fun Answer Goal) (pr NewResumeStack NewRootAnswer),
     /* add new cnode to g's dependents */
-    /* std.map.remove Goal AssertionTable TempAssertionTable, */
-    coq.say "Add",
-    add Goal (entry Waiters [ Answer | Answers ]) AssertionTable NewAssertionTable,
+    coq.say "Update",
+    std.map2.update Goal (entry Waiters [ Answer | Answers ]) AssertionTable NewAssertionTable,
     coq.say "Done",
     !.
 
@@ -359,7 +546,7 @@ Elpi Accumulate lp:{{
       (consumer_node _ [ Subgoal | _ ] as CN)
       (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer) :-
       /* TODO: Consumer node is general instead of variable or hole */
-      if (find Subgoal AssertionTable (entry Waiters Answers))
+      if (std.map2.find Subgoal AssertionTable (entry Waiters Answers))
          (
           /* Map answers with consumer node */
           /* Add cnode onto G's dependents? */
@@ -367,8 +554,8 @@ Elpi Accumulate lp:{{
           std.append TempResumeStack ResumeStack NewResumeStack,
 
           NewWaiters = [ callback CN | Waiters ],
-              /* std.map.remove Subgoal AssertionTable TempAssertionTable, */
-          add Subgoal (entry NewWaiters Answers) AssertionTable NewAssertionTable,
+              /* std.map2.remove Subgoal AssertionTable TempAssertionTable, */
+          std.map2.update Subgoal (entry NewWaiters Answers) AssertionTable NewAssertionTable,
           NewGeneratorStack = GeneratorStack
          )
          (
@@ -388,7 +575,7 @@ Elpi Accumulate lp:{{
   tabled_typeclass_resolution_body (synth _ _ _ (some Answer)) _ _ Answer.
 
   tabled_typeclass_resolution_body
-    (synth GeneratorStack [ (pr (consumer_node Goal [ Subgoal | Remaining ]) Answer) | ResumeStack ]
+      (synth GeneratorStack [ (pr (consumer_node Goal [ Subgoal | Remaining ]) Answer) | ResumeStack ]
        AssertionTable RootAnswer) Query MySynth FinalAnswer :-
     Answer = assertion AnswerT AnswerV,
     coq.typecheck AnswerV AnswerNT ok,
@@ -415,8 +602,10 @@ Elpi Accumulate lp:{{
   tabled_typeclass_resolution_body
     (synth [ generator_node Goal [Instance | Instances ] | GeneratorStack ]
       ResumeStack AssertionTable RootAnswer) Query NewSynth FinalAnswer :-
+    coq.say "Try",
     if (try_resolve Goal Instance Resolved Subgoals)
        (
+         coq.say "YES",
          /* else (l. 14) */
          new_consumer_node
           (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
@@ -424,6 +613,7 @@ Elpi Accumulate lp:{{
           (consumer_node Resolved Subgoals) NewSynth
        )
        (
+         coq.say "NO",
          /* If first subgoal of cnode does not resolve with solution then Continue */
          NewSynth = (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
        ).
@@ -452,11 +642,12 @@ Elpi Accumulate lp:{{
     tabled_typeclass_resolution_body MySynth Query NextSynth FinalAnswer,
     !,
     NextFuel is Fuel - 1,
+    coq.say "Copy synth?",
     synth_loop NextSynth Query NextFuel FinalAnswer.
 
   pred tabled_typeclass_resolution i:assertion o:assertion.
   tabled_typeclass_resolution Query FinalAnswer :-
-    make assertion_equal AssertionTableEmpty,
+    std.map2.make assertion_equal AssertionTableEmpty,
     new_subgoal (synth [] [] AssertionTableEmpty none) Query root MySynth,
     /* while true do */
     synth_loop MySynth Query 20000 FinalAnswer,

From 40004758662a36b84b279c92e440ec759d3dec54 Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Tue, 12 Aug 2025 22:07:21 +0200
Subject: [PATCH 15/23] Moved elpi code to elpi folder

---
 apps/tc-tabled/elpi/dune                      |   3 +-
 apps/tc-tabled/elpi/tabled_type_class.elpi    | 655 ++++++++++++++++
 apps/tc-tabled/src/dune                       |  11 +
 apps/tc-tabled/src/dune.in                    |   9 +
 .../src/rocq_elpi_tc_tabled_hook.mlg          |  12 +
 apps/tc-tabled/theories/diamond.v             |   6 +-
 apps/tc-tabled/theories/dune                  |   4 +-
 apps/tc-tabled/theories/tabled_type_class.v   | 741 +-----------------
 8 files changed, 696 insertions(+), 745 deletions(-)
 create mode 100644 apps/tc-tabled/elpi/tabled_type_class.elpi
 create mode 100644 apps/tc-tabled/src/dune
 create mode 100644 apps/tc-tabled/src/dune.in
 create mode 100644 apps/tc-tabled/src/rocq_elpi_tc_tabled_hook.mlg

diff --git a/apps/tc-tabled/elpi/dune b/apps/tc-tabled/elpi/dune
index 32ffac8ad..16c639362 100644
--- a/apps/tc-tabled/elpi/dune
+++ b/apps/tc-tabled/elpi/dune
@@ -1,7 +1,7 @@
 (coq.theory
  (name elpi.apps.tc_tabled.elpi)
  (package rocq-elpi)
- (theories elpi elpi.apps.tc elpi.apps.tc.elpi))
+ (theories elpi))
 
 (rule
  (target dummy.v)
@@ -14,7 +14,6 @@
 
 (install
  (files
-  (glob_files (*.elpi with_prefix coq/user-contrib/elpi/apps/tc/elpi/))
   (glob_files (*.elpi with_prefix coq/user-contrib/elpi/apps/tc-tabled/elpi/)))
  (section lib_root)
  (package rocq-elpi))
diff --git a/apps/tc-tabled/elpi/tabled_type_class.elpi b/apps/tc-tabled/elpi/tabled_type_class.elpi
new file mode 100644
index 000000000..86408d2e2
--- /dev/null
+++ b/apps/tc-tabled/elpi/tabled_type_class.elpi
@@ -0,0 +1,655 @@
+pred binary_search i:K i:(pred i:K i:K o:cmp) i:int i:int i:list K o:int o:bool.
+binary_search A Cmp L R XS Out Approx :-
+  if (le_ L R)
+   	(M is L + ((R - L) div 2),
+   	std.nth M XS X,
+   	Cmp X A C,
+    !,
+   	if (C = lt)
+ 	     (!, binary_search A Cmp (M + 1) R XS Out Approx)
+ 	     (if (C = gt)
+ 	         (!, binary_search A Cmp L (M - 1) XS Out Approx)
+ 	         (!, Out is M, Approx = ff)))
+ 	  (Out is L, Approx = tt)
+    , !.
+
+kind std.map2 type -> type -> type.
+type std.map2 std.map2.private.map K V -> (pred i:K, i:K, o:cmp) -> std.map2 K V.
+
+namespace std.map2 {
+
+% [make Eq Ltn M] builds an empty map M where keys are compared using Eq and Ltn
+pred make i:(pred i:K, i:K, o:cmp), o:std.map2 K V.
+make Cmp (std.map2 private.empty Cmp).
+
+
+% [find K M V] looks in M for the value V associated to K
+pred find i:K, i:std.map2 K V, o:V.
+find K (std.map2 M Cmp) V :- 
+  coq.say "Find",
+  private.find M Cmp K V,
+  coq.say "FY".
+find _ _ _ :- coq.say "FN", fail.
+
+% [add K V M M1] M1 is M where K is bound to V
+pred add i:K, i:V, i:std.map2 K V, o:std.map2 K V.
+add K V (std.map2 M Cmp) (std.map2 M1 Cmp) :- 
+  private.add M Cmp K V M1.
+
+% [update K V M M1] M1 is M where K is bound to V
+pred update i:K, i:V, i:std.map2 K V, o:std.map2 K V.
+update K V (std.map2 M Cmp) (std.map2 M1 Cmp) :- 
+  private.update M Cmp K V M1.
+
+% [remove K M M1] M1 is M where K is unbound
+pred remove i:K, i:std.map2 K V, o:std.map2 K V.
+remove K (std.map2 M Cmp) (std.map2 M1 Cmp) :- private.remove M Cmp K M1.
+
+% [bindings M L] L is the key-value pairs in increasing order
+pred bindings i:std.map2 K V, o:list (pair K V).
+bindings (std.map2 M _) L :- private.bindings M [] L.
+
+namespace private {
+
+% Taken from OCaml's map.ml
+kind map type -> type -> type.
+type empty map K V.
+type node map K V -> K -> V -> map K V -> int -> map K V.
+
+pred height i:map K V, o:int.
+height empty 0.
+height (node _ _ _ _ H) H.
+
+pred create i:map K V, i:K, i:V, i:map K V, o:map K V.
+create L K V R (node L K V R H) :- H is {std.max {height L} {height R} } + 1.
+
+pred print_m i:(map K V) o:string.
+print_m (empty) "emtpy". 
+print_m (node L _ _ R I) S :-
+  print_m L SL,
+  print_m R SR,
+  S is "(" ^ SL ^ "," ^ "," ^ SR ^ ")"
+  .
+
+pred bal i:map K V, i:K, i:V, i:map K V, o:map K V.
+bal L K V R T :-
+  height L HL,
+  height R HR,
+  HL2 is HL + 2,
+  HR2 is HR + 2,
+  bal.aux HL HR HL2 HR2 L K V R T.
+
+pred bal.aux i:int, i:int, i:int, i:int, i:map K V, i:K, i:V, i:map K V, o:map K V.
+bal.aux HL _ _ HR2 (node LL LV LD LR _) X D R T :-
+  HL > HR2, {height LL} >= {height LR}, !,
+  create LL LV LD {create LR X D R} T.
+bal.aux HL _ _ HR2 (node LL LV LD (node LRL LRV LRD LRR _) _) X D R T :-
+  HL > HR2, !,
+  create {create LL LV LD LRL} LRV LRD {create LRR X D R} T.
+bal.aux _ HR HL2 _ L X D (node RL RV RD RR _) T :-
+  HR > HL2, {height RR} >= {height RL}, !,
+  create {create L X D RL} RV RD RR T.
+bal.aux _ HR HL2 _ L X D (node (node RLL RLV RLD RLR _) RV RD RR _) T :-
+  HR > HL2, !,
+  create {create L X D RLL} RLV RLD {create RLR RV RD RR} T.
+bal.aux _ _ _ _ L K V R T :- create L K V R T.
+
+pred add i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
+add empty _ K V T :- create empty K V empty T.
+add (node _ X _ _ _ as M) Cmp X1 XD M1 :- Cmp X1 X E, !, add.aux E M Cmp X1 XD M1.
+
+pred add.aux i:cmp, i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
+add.aux eq (node L _ _ R H) _   X XD T :- T = node L X XD R H, !. 
+add.aux lt (node L V D R _) Cmp X XD T :- bal {add L Cmp X XD} V D R T, !.
+add.aux gt (node L V D R _) Cmp X XD T :- bal L V D {add R Cmp X XD} T, !.
+
+pred update i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
+update (node _ X _ _ _ as M) Cmp X1 XD M1 :- 
+  !, Cmp X1 X E, !, update.aux E M Cmp X1 XD M1, !.
+
+pred update.aux i:cmp, i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
+update.aux eq (node L _ _ R H) _   X XD T :- 
+  T = node L X XD R H, !. 
+update.aux lt (node L V D R H) Cmp X XD T :- 
+  T = node {update L Cmp X XD} V D R H, !.
+update.aux gt (node L V D R H) Cmp X XD T :- 
+  T = node L V D {update R Cmp X XD} H, !.
+
+pred find i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:V.
+find ((node L K1 V1 R _) as M) Cmp K V :- 
+  Cmp K K1 E, find.aux E Cmp L R V1 K V.
+
+pred find.aux i:cmp, i:(pred i:K, i:K, o:cmp), i:map K V, i:map K V, i:V, i:K, o:V.
+find.aux eq _   _ _ V _ V.
+find.aux lt Cmp L _ _ K V :- find L Cmp K V.
+find.aux gt Cmp _ R _ K V :- find R Cmp K V.
+
+pred remove-min-binding i:map K V, o:map K V.
+remove-min-binding (node empty _ _ R _) R :- !.
+remove-min-binding (node L V D R _) X :- bal {remove-min-binding L} V D R X.
+
+pred min-binding i:map K V, o:K, o:V.
+min-binding (node empty V D _ _) V D :- !.
+min-binding (node L _ _ _ _) V D :- min-binding L V D.
+
+pred merge i:map K V, i:map K V, o:map K V.
+merge empty X X :- !.
+merge X empty X :- !.
+merge M1 M2 R :-
+  min-binding M2 X D,
+  bal M1 X D {remove-min-binding M2} R.
+
+pred remove i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:map K V.
+remove empty _ _ empty :- !.
+remove (node L V D R _) Cmp X M :- Cmp X V E, remove.aux E Cmp L R V D X M.
+
+pred remove.aux i:cmp, i:(pred i:K, i:K, o:cmp), i:map K V, i:map K V, i:K, i:V, i:K, o:map K V.
+remove.aux eq _   L R _ _ _ M :- merge L R M.
+remove.aux lt Cmp L R V D X M :- bal {remove L Cmp X} V D R M.
+remove.aux gt Cmp L R V D X M :- bal L V D {remove R Cmp X} M.
+
+pred bindings i:map K V, i:list (pair K V), o:list (pair K V).
+bindings empty X X.
+bindings (node L V D R _) X X1 :-
+  bindings L [pr V D|{bindings R X}] X1.
+
+
+} % std.map2.private
+} % std.map2
+
+
+
+kind mymap type -> type -> type.
+type mymap list (pair K V) -> (pred i:K i:K o:cmp) -> mymap K V.
+
+% [make Eq Ltn M] builds an empty map M where keys are compared using Eq and Ltn
+pred make i:(pred i:K, i:K, o:cmp), o:mymap K V.
+make Cmp (mymap [] Cmp).
+
+pred cmp_fst_pair i:(pred i:K i:K o:cmp) i:pair K V i:pair K V o:cmp.
+cmp_fst_pair Cmp (pr K1 _) (pr K2 _) C :- Cmp K1 K2 C.
+
+% [find K M V] looks in M for the value V associated to K
+pred find i:K, i:mymap K V, o:V.
+find K (mymap M Cmp) V :-
+  coq.say "Find",
+  std.length M Len,
+  binary_search (pr K (_ /* dummy value */)) (cmp_fst_pair Cmp) 0 (Len - 1) M I ff,
+  !,
+  std.nth I M (pr KK V),
+  Cmp KK K eq,
+  !,
+  coq.say "FY".
+find _ _ _ :- coq.say "FN", fail.
+
+pred insert_index i:int i:V i:list V o:list V.
+insert_index I V L O :- /* std.append F [ (pr K VI) | T  ] M1 */
+  std.split-at I L F T,
+  !,
+  std.append F [ V | T ] O.
+/* insert_index 0 V L [ V | L ].
+insert_index N V [ X | L ] [ X | O ] :-
+  NN is N - 1,
+  insert_index NN V L O. */
+
+pred update_index i:int i:V i:list V o:list V.
+update_index I V L O :- /* T = [ pr KK _ | VS ] , Cmp KK K eq , std.append F [ (pr K VI) | VS ] M1 */
+  coq.say "split",
+  std.split-at I L F [ _ | T ],
+  !,
+  coq.say "append",
+  std.append F [ V | T ] O.
+/* update_index 0 V [ _ | L ] [ V | L ] :- !.
+update_index N V [ X | L ] [ X | O ] :-
+  NN is N - 1,
+  !,
+  update_index NN V L O,
+  !. */
+
+% [add K V M M1] M1 is M where K is bound to V
+pred add i:K, i:V, i:mymap K V, o:mymap K V.
+add K V (mymap M Cmp) (mymap M1 Cmp) :-
+  std.length M Len,
+  coq.say "Search",
+  binary_search (pr K (_ /* dummy value */)) (cmp_fst_pair Cmp) 0 (Len - 1) M I Approx,
+  if (Approx = tt)
+  (coq.say "Insert", insert_index I (pr K V) M M1) /* insert */
+  (coq.say "Update", update_index I (pr K V) M M1 ) /* update */
+  , coq.say "Done"
+  , !.
+
+/*
+(* https://github.com/leanprover/lean4/blob/cade21/src/Lean/Meta/SynthInstance.lean *)
+(* https://github.com/LPCIC/coq-elpi/blob/master/builtin-doc/coq-builtin.elpi *)
+(* Tabled type class : https://github.com/purefunctor/tabled-typeclass-resolution?tab=readme-ov-file *)
+(* https://github.com/purefunctor/tabled-typeclass-resolution/blob/main/src/lib.rs *)
+(* ty = https://github.com/leanprover/lean4/blob/cade21/src/Lean/Expr.lean#L152-L165 *)
+(* Coq-Stlc: https://lpcic.github.io/coq-elpi/stlc.txt *)
+(* https://github.com/leanprover/lean4/blob/master/src/Lean/Expr.lean#L302-L512 *)
+*/
+
+  typeabbrev ty term.
+
+  kind data type.
+  type data ty -> list data -> data.
+
+  kind assertion type.
+  type assertion term -> term -> assertion.
+
+  kind consumer_node type.
+  type consumer_node assertion -> list assertion -> consumer_node.
+
+  kind waiter type.
+  type root waiter.
+  type callback consumer_node -> waiter.
+
+  kind entry type.
+  type entry list waiter -> list assertion -> entry.
+
+  typeabbrev resume_stack (list (pair consumer_node assertion)).
+
+  typeabbrev instance tc-instance.
+
+  kind class_instances type.
+  type class_instances std.map2 assertion (list instance) -> class_instances.
+
+  kind generator_node type.
+  type generator_node assertion -> list instance -> generator_node.
+
+  kind synth type.
+  type synth list generator_node ->
+    resume_stack ->
+    std.map2 assertion entry ->
+    option assertion ->
+    synth.
+
+  pred type_equal i:ty i:ty o:cmp.
+  type_equal X Y Cmp :-
+    ground_term X,
+    ground_term Y,
+    cmp_term X Y Cmp.
+  type_equal X Y eq :- var X, var Y.
+  type_equal (app L) (app G) Cmp :- type_equal_list L G Cmp.
+  type_equal X Y lt :- var X, ground_term Y.
+  type_equal X Y gt :- ground_term X, var Y.
+
+  pred type_equal_list i:list ty i:list ty o:cmp.
+  type_equal_list [ X | XS ] [ Y | YS ] Cmp :-
+      type_equal X Y eq,
+      type_equal_list XS YS Cmp.
+  type_equal_list [ X | _ ] [ Y | _ ] Cmp :-
+      type_equal X Y Cmp,
+      not (Cmp = eq).
+  type_equal_list [] [] eq.
+
+
+  pred assertion_equal i:assertion i:assertion o:cmp.
+  assertion_equal (assertion A _) (assertion B _) Cmp :-
+  /* coq.say {coq.term->string A} "VS" {coq.term->string B}, */
+    type_equal A B Cmp,
+    !
+    /* Deterministic ! */
+    .
+
+  pred term_typeclass i:term o:gref.
+  term_typeclass (global Name) Name.
+  term_typeclass (app [X | _]) N :- term_typeclass X N.
+  term_typeclass (prod X T F) N :-
+    pi x\ term_typeclass (F x) N.
+
+  pred assertion_typeclass i:assertion o:gref.
+  assertion_typeclass (assertion G _) Name :- term_typeclass G Name.
+
+  pred new_subgoal i:synth i:assertion i:waiter o:synth.
+  new_subgoal
+    (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+    Subgoal Waiter
+    (synth NewGeneratorStack ResumeStack NewAssertionTable RootAnswer) :-
+    std.map2.add Subgoal (entry [Waiter] []) AssertionTable NewAssertionTable,
+    assertion_typeclass Subgoal Name,
+    coq.TC.db-for Name Instances,
+    NewGeneratorStack = [(generator_node Subgoal Instances) | GeneratorStack]
+    .
+
+/* Apply answer to goal and update meta variable context if it succeeds */
+
+  pred replace_var_term i:ty o:ty i:ty o:ty.
+  replace_var_term X Y (app L) (app G) :-
+    std.map L (replace_var_term X Y) G.
+  replace_var_term X Y Z W :-
+    var Z,
+    X == Z,
+    W = Y
+    .
+  replace_var_term X Y Z Z.
+
+  pred replace_var_in_list i:ty o:ty i:list assertion o:list assertion.
+  replace_var_in_list X Y [ assertion TA VA | AS ] [ assertion TB VB | BS ] :-
+      replace_var_term X Y TA TB,
+      replace_var_term X Y VA VB,
+      replace_var_in_list X Y AS BS.
+  replace_var_in_list _ _ [] [].
+
+  pred try_answer_type i:ty o:ty i:ty o:ty i:list assertion o:list assertion.
+  try_answer_type X Y IX IY Lin Lout :-
+    var X, var Y,
+    replace_var_term X Y IX IY,
+    replace_var_in_list X Y Lin Lout.
+  try_answer_type (app L) (app G) IX IY Lin Lout :-
+    try_answer_type_list L G IX IY Lin Lout.
+  try_answer_type X Y IX IY Lin Lout :-
+    var X, ground_term Y, replace_var_term X Y IX IY, replace_var_in_list X Y Lin Lout.
+  try_answer_type X Y I I L L :-
+    ground_term X,
+    ground_term Y,
+    cmp_term X Y eq.
+
+  pred try_answer_type_list i:list ty o:list ty i:ty o:ty i:list assertion o:list assertion.
+  try_answer_type_list [ X | XS ] [ Y | YS ] IX IY Lin Lout :-
+      try_answer_type X Y IX Itemp Lin Ltemp,
+      try_answer_type_list XS YS Itemp IY Ltemp Lout.
+  try_answer_type_list [] [] I I L L.
+
+  pred try_answer i:assertion o:assertion i:assertion o:assertion i:list assertion o:list assertion.
+  try_answer (assertion A VA) (assertion B VB) (assertion G IA) (assertion G IB) Lin Lout :-
+    try_answer_type A B IA ITemp Lin Lout,
+    replace_var_term VA VB ITemp IB.
+
+  pred replace_list i:list term i:term i:term o:list term.
+  replace_list [ A | XS ] A B [ B | YS ] :-
+      !,
+      replace_list XS A B YS.
+  replace_list [ C | XS ] A B [ C | YS ] :-
+      replace_list XS A B YS.
+  replace_list [] _ _ [].
+
+  pred extract_helper i:term i:int i:term o:term.
+  extract_helper X Index (prod N T F) (prod N T G) :-
+    !,
+    pi x\
+      extract_helper X Index (F x) (G x).
+  extract_helper X Index (app L) (app NewL) :-
+    !,
+    std.split-at Index L Lfront [ V | Ltail ],
+    replace_list L V X NewL.
+
+  pred is_var_at_index i:term i:int.
+  is_var_at_index (prod N T F) I :-
+    pi x\
+      is_var_at_index (F x) I.
+  is_var_at_index (app L) I :-
+    std.split-at I L Lfront [ T | Ltail],
+    var T.
+
+  pred extract_variables i:list term i:int o:term.
+    extract_variables L -1 (app L).
+  extract_variables L Index Tm :-
+    PrevIndex is Index - 1,
+    extract_variables L PrevIndex PrevTm,
+    !,
+    ((is_var_at_index PrevTm Index,
+     Tm = prod TmX TmT TmF,
+     pi x\
+       extract_helper x Index PrevTm (TmF x)
+    );
+    (Tm = PrevTm))
+    .
+
+  pred re_generalize i:list term o:list term.
+  re_generalize [ X | Tl ] R :-
+    coq.typecheck X T ok,
+    (
+      (T = (app Tlist),
+       std.length Tlist Len,
+       Index is Len - 1,
+       extract_variables Tlist Index NewR,
+       R = [ NewR | RTl ]
+       );
+      (R = RTl)
+    ),
+    re_generalize Tl RTl
+    .
+  re_generalize [ X | Tl ] [] :-
+    re_generalize Tl R.
+  re_generalize [ ] [].
+
+  pred tc_instance_to_term i:tc-instance o:term.
+  tc_instance_to_term (tc-instance (const C) _) T :-
+    coq.env.const C _ /* Body */ Type,
+    coq.gref->string (const C) _ /* Name */,
+    T = Type.
+
+  pred does_type_resolve i:term o:term.
+  does_type_resolve X Y :-
+    var Y,
+    X = Y.
+  does_type_resolve X Y :-
+    var X.
+  does_type_resolve (app L) (app G) :-
+    std.map L does_type_resolve G.
+  does_type_resolve X Y :-
+    ground_term X,
+    X = Y.
+
+  pred try_resolve_types i:term i:term o:list term o:list assertion.
+  try_resolve_types A (prod X T F) OL L :-
+    coq.typecheck V T ok,
+    try_resolve_types A (F V) OLS LS,
+    (OL = [ V | OLS]),
+    ((T = app _ ; L = [ assertion T V | LS ]) ; (L = LS)) /* TODO : better 'contains instance or var test' */
+    .
+  try_resolve_types A B [] [] :-
+    does_type_resolve A B
+    .
+
+  pred helper_fn i:term o:assertion.
+  helper_fn A (assertion A V).
+
+  pred simpl i:term o:term.
+  simpl (app [ prod X T F , Arg | Tl ]) R :-
+    simpl (app [ (F Arg) | Tl ]) R.
+  simpl (app [ A ]) A.
+  simpl A A.
+
+  pred filter_metavariables i:list assertion o:list assertion.
+  filter_metavariables [ assertion (app L) V | XS ] [ assertion (app L) V | YS ] :-
+      !, filter_metavariables XS YS.
+  filter_metavariables [ assertion X _ | XS ] YS :-
+      filter_metavariables XS YS.
+  filter_metavariables [] [].
+
+
+  pred try_resolve i:assertion i:instance o:assertion o:list assertion.
+  try_resolve (assertion A _) (tc-instance BI _) (assertion RT RV) RL :-
+    tc_instance_to_term (tc-instance BI _) B,
+    coq.env.global BI BITm,
+    coq.gref->string BI BIName,
+    BI = const (BIConst),
+    coq.env.const BIConst (some BIBody) BITy,
+    try_resolve_types A B OL L,
+    filter_metavariables L RL,
+    !,
+    RT = A,
+    ((OL = [], RV = BITm) ; RV = app [ BITm | OL ])
+    .
+
+  pred temp_fun i:consumer_node i:assertion o:(pair consumer_node assertion).
+  temp_fun A B (pr A B).
+
+  pred waiter_fun i:assertion i:assertion i:waiter i:(pair (resume_stack) (option assertion)) o:(pair (resume_stack) (option assertion)).
+  waiter_fun Answer Guess root (pr A _) (pr A (some Answer)).
+  waiter_fun Answer Goal (callback C) (pr A R) (pr [pr C Answer /* Goal */ | A] R).
+
+  pred new_consumer_node i:synth i:assertion i:consumer_node o:synth.
+  new_consumer_node
+      (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+      Answer
+      (consumer_node Goal [])
+      (synth GeneratorStack NewResumeStack NewAssertionTable NewRootAnswer) :-
+    /* for each solution to g, push new cnode onto resume stack with it */
+    std.map2.find Goal AssertionTable (entry Waiters Answers),
+    /* for each solution to g, push new cnode onto resume stack with it */
+    std.fold Waiters (pr ResumeStack RootAnswer) (waiter_fun Answer Goal) (pr NewResumeStack NewRootAnswer),
+    /* add new cnode to g's dependents */
+    coq.say "Update",
+    std.map2.update Goal (entry Waiters [ Answer | Answers ]) AssertionTable NewAssertionTable,
+    coq.say "Done",
+    !.
+
+  new_consumer_node
+      (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+      _
+      (consumer_node _ [ Subgoal | _ ] as CN)
+      (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer) :-
+      /* TODO: Consumer node is general instead of variable or hole */
+      if (std.map2.find Subgoal AssertionTable (entry Waiters Answers))
+         (
+          /* Map answers with consumer node */
+          /* Add cnode onto G's dependents? */
+          std.map Answers (temp_fun CN) TempResumeStack,
+          std.append TempResumeStack ResumeStack NewResumeStack,
+
+          NewWaiters = [ callback CN | Waiters ],
+              /* std.map2.remove Subgoal AssertionTable TempAssertionTable, */
+          std.map2.update Subgoal (entry NewWaiters Answers) AssertionTable NewAssertionTable,
+          NewGeneratorStack = GeneratorStack
+         )
+         (
+          new_subgoal
+            (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+            Subgoal
+            (callback CN)
+            (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer)
+        ),
+        !.
+
+    new_consumer_node _ _ _ _ :- coq.error "Failed new consumer node!" , fail.
+
+  pred tabled_typeclass_resolution_body i:synth i:assertion o:synth o:assertion.
+  tabled_typeclass_resolution_body (synth _ _ _ (some Answer)) _ _ Answer.
+
+  tabled_typeclass_resolution_body
+      (synth GeneratorStack [ (pr (consumer_node Goal [ Subgoal | Remaining ]) Answer) | ResumeStack ]
+       AssertionTable RootAnswer) Query MySynth FinalAnswer :-
+    Answer = assertion AnswerT AnswerV,
+    coq.typecheck AnswerV AnswerNT ok,
+    NewAnswer = assertion AnswerNT AnswerV,
+    if (try_answer Subgoal NewAnswer Goal UpdatedGoal Remaining UpdatedRemaining)
+       (
+        /* TODO: Update Remaining with unification from try_answer ! */
+        new_consumer_node
+         (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+         UpdatedGoal /* TODO: final answer here! */
+         (consumer_node UpdatedGoal UpdatedRemaining) /* TODO: Was Goal in code, but should add new solution? */
+         MySynth
+      )
+      (
+        MySynth = (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+      ).
+
+  tabled_typeclass_resolution_body
+    (synth GeneratorStack [ (pr (consumer_node Goal []) Answer) | ResumeStack ]
+       AssertionTable RootAnswer) Query MySynth FinalAnswer :-
+   coq.warn "Cannot resume with empty subgoals!",
+   fail.
+
+  tabled_typeclass_resolution_body
+    (synth [ generator_node Goal [Instance | Instances ] | GeneratorStack ]
+      ResumeStack AssertionTable RootAnswer) Query NewSynth FinalAnswer :-
+    coq.say "Try",
+    if (try_resolve Goal Instance Resolved Subgoals)
+       (
+         coq.say "YES",
+         /* else (l. 14) */
+         new_consumer_node
+          (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
+          Resolved
+          (consumer_node Resolved Subgoals) NewSynth
+       )
+       (
+         coq.say "NO",
+         /* If first subgoal of cnode does not resolve with solution then Continue */
+         NewSynth = (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
+       ).
+
+  tabled_typeclass_resolution_body
+    (synth [ generator_node _ [] | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
+      Query
+      (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+      FinalAnswer.
+  /* If cnode has no remaining subgoals then (ll.7-13) .. */
+
+  tabled_typeclass_resolution_body (synth [] [] _ _) _ _ _ :- fail.
+
+  pred synth_loop i:synth i:assertion i:int o:assertion.
+  synth_loop (synth _ _ _ (some Answer)) _ Fuel Answer.
+  synth_loop MySynth Query Fuel FinalAnswer :-
+    MySynth = synth Stack1 Stack2 _ _,
+    coq.say "synth round" Fuel,
+    ((Stack1 = [ generator_node (assertion (StkHd1T) (StkHd1V)) L1 | _ ] , coq.say "topG:" {coq.term->string StkHd1T} {coq.term->string StkHd1V} L1); true),
+    ((Stack2 = [ pr (consumer_node (assertion StkHd2T StkHd2V) _) (assertion AnsT AnsV) | _ ] , coq.say "topR:" {coq.term->string StkHd2T} {coq.term->string StkHd2V}, coq.say "answer:" {coq.term->string AnsT} {coq.term->string AnsV}); true),
+    coq.say "",
+    /* coq.say "synth round" Fuel Stack2 Stack1, */
+    Fuel > 0,
+    tabled_typeclass_resolution_body MySynth Query NextSynth FinalAnswer,
+    !,
+    NextFuel is Fuel - 1,
+    coq.say "Copy synth?",
+    synth_loop NextSynth Query NextFuel FinalAnswer.
+
+  pred tabled_typeclass_resolution i:assertion o:assertion.
+  tabled_typeclass_resolution Query FinalAnswer :-
+    std.map2.make assertion_equal AssertionTableEmpty,
+    new_subgoal (synth [] [] AssertionTableEmpty none) Query root MySynth,
+    /* while true do */
+    synth_loop MySynth Query 20000 FinalAnswer,
+    !.
+
+  pred proof_search i:list gref i:list tc-instance i:term o:term.
+  proof_search Typeclasses [tc-instance Hd _ | _ ] Type PRoof :-
+    coq.env.typeof Hd TypeRes,
+    coq.env.global Hd ProofRes,
+    coq.say "CHECKING" TypeRes,
+    coq.unify-eq TypeRes Type D,
+    coq.say D,
+    D = ok,
+    % TypeRes = Type,
+    coq.say "SUCCESS",
+    PRoof = ProofRes.
+  proof_search Typeclasses [_|Tl] Type PRoof :-
+    proof_search Typeclasses Tl Type PRoof.
+
+  pred tabled_proof_search i:list gref i:term o:term.
+  tabled_proof_search Typeclasses Type PRoof :-
+    coq.say "TYPECLASSES" Typeclasses,
+    MyGoal = assertion Type {{ _ }},
+    tabled_typeclass_resolution MyGoal FinalAnswer,
+    !,
+
+    /* Convert from result to proof term! */
+
+    FinalAnswer = assertion FinalType FinalTerm,
+    FinalProof = FinalTerm,
+    coq.say "FinalProof" {coq.term->string FinalProof},
+    PRoof = FinalProof,
+    coq.say "Proof" {coq.term->string PRoof} "Done"
+    .
+
+
+  pred search_context i:list prop i:term o:term.
+  search_context [decl Te N Ty | _] Type PRoof :-
+    Ty = Type,
+    Te = PRoof,
+    coq.say "CHECK SUCC" N PRoof.
+  search_context [_|Tl] Type PRoof :- search_context Tl Type PRoof.
+
+  solve (goal Ctx Trigger Type PRoof Args as G) V :-
+    coq.TC.db-tc Typeclasses,
+    coq.say "AGRS" Args Ctx,
+    coq.say "SEARCHING ..." {coq.term->string Type}, !,
+    coq.say "V" V,
+    (search_context Ctx Type PRoof ; tabled_proof_search Typeclasses Type PRoof),
+    coq.say "SUCCESS FINDING INSTANCE".
+
+
+  solve _ _ :- coq.ltac.fail _ "No auto".
diff --git a/apps/tc-tabled/src/dune b/apps/tc-tabled/src/dune
new file mode 100644
index 000000000..e20e01ede
--- /dev/null
+++ b/apps/tc-tabled/src/dune
@@ -0,0 +1,11 @@
+; generated by make, do not edit
+
+(library
+ (name elpi_tc_tabled_plugin)
+ (public_name rocq-elpi.tc-tabled)
+ (flags :standard -w -27)
+ (preprocess (pps ppx_optcomp -- -cookie "ppx_optcomp.env=env ~coq:(Defined \"%{coq:version.major}.%{coq:version.minor}\")"))
+ (libraries rocq-runtime.plugins.ltac rocq-runtime.vernac rocq-elpi.elpi))
+
+(coq.pp
+ (modules rocq_elpi_tc_tabled_hook))
diff --git a/apps/tc-tabled/src/dune.in b/apps/tc-tabled/src/dune.in
new file mode 100644
index 000000000..2b368d3a9
--- /dev/null
+++ b/apps/tc-tabled/src/dune.in
@@ -0,0 +1,9 @@
+(library
+ (name elpi_tc_tabled_plugin)
+ (public_name rocq-elpi.tc-tabled)
+ (flags :standard -w -27)
+ (preprocess (pps ppx_optcomp -- -cookie "ppx_optcomp.env=env ~coq:(Defined \"%{coq:version.major}.%{coq:version.minor}\")"))
+ (libraries @@ROCQ_RUNTIME@@.plugins.ltac @@ROCQ_RUNTIME@@.vernac rocq-elpi.elpi))
+
+(coq.pp
+ (modules rocq_elpi_tc_tabled_hook))
diff --git a/apps/tc-tabled/src/rocq_elpi_tc_tabled_hook.mlg b/apps/tc-tabled/src/rocq_elpi_tc_tabled_hook.mlg
new file mode 100644
index 000000000..ef537fc66
--- /dev/null
+++ b/apps/tc-tabled/src/rocq_elpi_tc_tabled_hook.mlg
@@ -0,0 +1,12 @@
+(* license: GNU Lesser General Public License Version 2.1 or later           *)
+(* ------------------------------------------------------------------------- *)
+
+DECLARE PLUGIN "rocq-elpi.tc-tabled"
+
+{
+open Stdarg
+open Elpi_plugin
+(* open Rocq_elpi_arg_syntax *)
+(* open Rocq_elpi_tc_register *)
+(* open Rocq_elpi_class_tactics_takeover *)
+}
diff --git a/apps/tc-tabled/theories/diamond.v b/apps/tc-tabled/theories/diamond.v
index 0c550136c..83779ebfb 100644
--- a/apps/tc-tabled/theories/diamond.v
+++ b/apps/tc-tabled/theories/diamond.v
@@ -78,10 +78,10 @@ From elpi.apps.tc_tabled Require Import tabled_type_class.
 Elpi TC Solver Activate TC.TabledSolver.
 Elpi TC Solver Override TC.TabledSolver All.
 
-(* Module Test20Tabled. Time Instance TtR20 : B unit 20 := _. End Test20Tabled. *)
+Module Test20Tabled. Time Instance TtR20 : B unit 20 := _. End Test20Tabled.
 
-(* (* Finished transaction in 55.794 secs (55.684u,0.097s) (successful) *) *)
-(* Module Test100Tabled. Time Instance TtR100 : B unit 100 := _. End Test100Tabled. *)
+(* Finished transaction in 55.794 secs (55.684u,0.097s) (successful) *)
+Module Test100Tabled. Time Instance TtR100 : B unit 100 := _. End Test100Tabled.
 
 (* (* Finished transaction in 737.925 secs (736.366u,0.837s) (successful) *) *)
 (* Module Test200Tabled. Time Instance TtR200 : B unit 200 := _. End Test200Tabled. *)
diff --git a/apps/tc-tabled/theories/dune b/apps/tc-tabled/theories/dune
index 0b9184e13..0982f7a46 100644
--- a/apps/tc-tabled/theories/dune
+++ b/apps/tc-tabled/theories/dune
@@ -1,8 +1,8 @@
 (coq.theory
  (name elpi.apps.tc_tabled)
  (package rocq-elpi)
- (theories elpi elpi.apps.tc)
+ (theories elpi elpi.apps.tc elpi.apps.tc_tabled.elpi)
  (flags -w -all -w -elpi)
- (plugins rocq-elpi.tc ))
+ (plugins rocq-elpi.tc-tabled))
 
 (include_subdirs qualified)
diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index e5b9b07b6..9fbf1c11b 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -4,744 +4,9 @@ From elpi.apps Require Import tc.
 Elpi Tactic TC.TabledSolver.
 Elpi TC Solver Register TC.TabledSolver.
 
-Elpi Accumulate lp:{{
-pred binary_search i:K i:(pred i:K i:K o:cmp) i:int i:int i:list K o:int o:bool.
-/* binary_search A Cmp L R [ X | XS ] Out Approx :-
-  /* Linear search .. */
-  if (Cmp X A lt)
-     (binary_search A Cmp (L + 1) R XS Out Approx)
-     (Out is L,
-      if (Cmp X A eq)
-         (Approx = ff)
-         (Approx = tt))
-  , !.
-binary_search A Cmp L _ [] Out Approx :-
-!, Approx = tt, Out is L. */
-binary_search A Cmp L R XS Out Approx :-
-  if (le_ L R)
-   	(M is L + ((R - L) div 2),
-   	std.nth M XS X,
-   	Cmp X A C,
-    !,
-   	if (C = lt)
- 	     (!, binary_search A Cmp (M + 1) R XS Out Approx)
- 	     (if (C = gt)
- 	         (!, binary_search A Cmp L (M - 1) XS Out Approx)
- 	         (!, Out is M, Approx = ff)))
- 	  (Out is L, Approx = tt)
-    , !.
-}}.
+Declare ML Module "rocq-elpi.tc-tabled".
 
-Elpi Accumulate lp:{{
-kind std.map2 type -> type -> type.
-type std.map2 std.map2.private.map K V -> (pred i:K, i:K, o:cmp) -> std.map2 K V.
-
-namespace std.map2 {
-
-% [make Eq Ltn M] builds an empty map M where keys are compared using Eq and Ltn
-pred make i:(pred i:K, i:K, o:cmp), o:std.map2 K V.
-make Cmp (std.map2 private.empty Cmp).
-
-
-% [find K M V] looks in M for the value V associated to K
-pred find i:K, i:std.map2 K V, o:V.
-find K (std.map2 M Cmp) V :- 
-  coq.say "Find",
-  private.find M Cmp K V,
-  coq.say "FY".
-find _ _ _ :- coq.say "FN", fail.
-
-% [add K V M M1] M1 is M where K is bound to V
-pred add i:K, i:V, i:std.map2 K V, o:std.map2 K V.
-add K V (std.map2 M Cmp) (std.map2 M1 Cmp) :- 
-  private.add M Cmp K V M1.
-
-% [update K V M M1] M1 is M where K is bound to V
-pred update i:K, i:V, i:std.map2 K V, o:std.map2 K V.
-update K V (std.map2 M Cmp) (std.map2 M1 Cmp) :- 
-  private.update M Cmp K V M1.
-
-% [remove K M M1] M1 is M where K is unbound
-pred remove i:K, i:std.map2 K V, o:std.map2 K V.
-remove K (std.map2 M Cmp) (std.map2 M1 Cmp) :- private.remove M Cmp K M1.
-
-% [bindings M L] L is the key-value pairs in increasing order
-pred bindings i:std.map2 K V, o:list (pair K V).
-bindings (std.map2 M _) L :- private.bindings M [] L.
-
-namespace private {
-
-% Taken from OCaml's map.ml
-kind map type -> type -> type.
-type empty map K V.
-type node map K V -> K -> V -> map K V -> int -> map K V.
-
-pred height i:map K V, o:int.
-height empty 0.
-height (node _ _ _ _ H) H.
-
-pred create i:map K V, i:K, i:V, i:map K V, o:map K V.
-create L K V R (node L K V R H) :- H is {std.max {height L} {height R} } + 1.
-
-pred print_m i:(map K V) o:string.
-print_m (empty) "emtpy". 
-print_m (node L _ _ R I) S :-
-  print_m L SL,
-  print_m R SR,
-  S is "(" ^ SL ^ "," ^ "," ^ SR ^ ")"
-  .
-
-pred bal i:map K V, i:K, i:V, i:map K V, o:map K V.
-bal L K V R T :-
-  height L HL,
-  height R HR,
-  HL2 is HL + 2,
-  HR2 is HR + 2,
-  bal.aux HL HR HL2 HR2 L K V R T.
-
-pred bal.aux i:int, i:int, i:int, i:int, i:map K V, i:K, i:V, i:map K V, o:map K V.
-bal.aux HL _ _ HR2 (node LL LV LD LR _) X D R T :-
-  HL > HR2, {height LL} >= {height LR}, !,
-  create LL LV LD {create LR X D R} T.
-bal.aux HL _ _ HR2 (node LL LV LD (node LRL LRV LRD LRR _) _) X D R T :-
-  HL > HR2, !,
-  create {create LL LV LD LRL} LRV LRD {create LRR X D R} T.
-bal.aux _ HR HL2 _ L X D (node RL RV RD RR _) T :-
-  HR > HL2, {height RR} >= {height RL}, !,
-  create {create L X D RL} RV RD RR T.
-bal.aux _ HR HL2 _ L X D (node (node RLL RLV RLD RLR _) RV RD RR _) T :-
-  HR > HL2, !,
-  create {create L X D RLL} RLV RLD {create RLR RV RD RR} T.
-bal.aux _ _ _ _ L K V R T :- create L K V R T.
-
-pred add i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
-add empty _ K V T :- create empty K V empty T.
-add (node _ X _ _ _ as M) Cmp X1 XD M1 :- Cmp X1 X E, !, add.aux E M Cmp X1 XD M1.
-
-pred add.aux i:cmp, i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
-add.aux eq (node L _ _ R H) _   X XD T :- T = node L X XD R H, !. 
-add.aux lt (node L V D R _) Cmp X XD T :- bal {add L Cmp X XD} V D R T, !.
-add.aux gt (node L V D R _) Cmp X XD T :- bal L V D {add R Cmp X XD} T, !.
-
-pred update i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
-update (node _ X _ _ _ as M) Cmp X1 XD M1 :- 
-  !, Cmp X1 X E, !, update.aux E M Cmp X1 XD M1, !.
-
-pred update.aux i:cmp, i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
-update.aux eq (node L _ _ R H) _   X XD T :- 
-  T = node L X XD R H, !. 
-update.aux lt (node L V D R H) Cmp X XD T :- 
-  T = node {update L Cmp X XD} V D R H, !.
-update.aux gt (node L V D R H) Cmp X XD T :- 
-  T = node L V D {update R Cmp X XD} H, !.
-
-pred find i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:V.
-find ((node L K1 V1 R _) as M) Cmp K V :- 
-  Cmp K K1 E, find.aux E Cmp L R V1 K V.
-
-pred find.aux i:cmp, i:(pred i:K, i:K, o:cmp), i:map K V, i:map K V, i:V, i:K, o:V.
-find.aux eq _   _ _ V _ V.
-find.aux lt Cmp L _ _ K V :- find L Cmp K V.
-find.aux gt Cmp _ R _ K V :- find R Cmp K V.
-
-pred remove-min-binding i:map K V, o:map K V.
-remove-min-binding (node empty _ _ R _) R :- !.
-remove-min-binding (node L V D R _) X :- bal {remove-min-binding L} V D R X.
-
-pred min-binding i:map K V, o:K, o:V.
-min-binding (node empty V D _ _) V D :- !.
-min-binding (node L _ _ _ _) V D :- min-binding L V D.
-
-pred merge i:map K V, i:map K V, o:map K V.
-merge empty X X :- !.
-merge X empty X :- !.
-merge M1 M2 R :-
-  min-binding M2 X D,
-  bal M1 X D {remove-min-binding M2} R.
-
-pred remove i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:map K V.
-remove empty _ _ empty :- !.
-remove (node L V D R _) Cmp X M :- Cmp X V E, remove.aux E Cmp L R V D X M.
-
-pred remove.aux i:cmp, i:(pred i:K, i:K, o:cmp), i:map K V, i:map K V, i:K, i:V, i:K, o:map K V.
-remove.aux eq _   L R _ _ _ M :- merge L R M.
-remove.aux lt Cmp L R V D X M :- bal {remove L Cmp X} V D R M.
-remove.aux gt Cmp L R V D X M :- bal L V D {remove R Cmp X} M.
-
-pred bindings i:map K V, i:list (pair K V), o:list (pair K V).
-bindings empty X X.
-bindings (node L V D R _) X X1 :-
-  bindings L [pr V D|{bindings R X}] X1.
-
-
-} % std.map2.private
-} % std.map2
-}}.
-
-(*
-Elpi Accumulate lp:{{
-kind mymap type -> type -> type.
-type mymap list (pair K V) -> (pred i:K i:K o:cmp) -> mymap K V.
-
-% [make Eq Ltn M] builds an empty map M where keys are compared using Eq and Ltn
-pred make i:(pred i:K, i:K, o:cmp), o:mymap K V.
-make Cmp (mymap [] Cmp).
-
-pred cmp_fst_pair i:(pred i:K i:K o:cmp) i:pair K V i:pair K V o:cmp.
-cmp_fst_pair Cmp (pr K1 _) (pr K2 _) C :- Cmp K1 K2 C.
-
-% [find K M V] looks in M for the value V associated to K
-pred find i:K, i:mymap K V, o:V.
-find K (mymap M Cmp) V :-
-  coq.say "Find",
-  std.length M Len,
-  binary_search (pr K (_ /* dummy value */)) (cmp_fst_pair Cmp) 0 (Len - 1) M I ff,
-  !,
-  std.nth I M (pr KK V),
-  Cmp KK K eq,
-  !,
-  coq.say "FY".
-find _ _ _ :- coq.say "FN", fail.
-
-pred insert_index i:int i:V i:list V o:list V.
-insert_index I V L O :- /* std.append F [ (pr K VI) | T  ] M1 */
-  std.split-at I L F T,
-  !,
-  std.append F [ V | T ] O.
-/* insert_index 0 V L [ V | L ].
-insert_index N V [ X | L ] [ X | O ] :-
-  NN is N - 1,
-  insert_index NN V L O. */
-
-pred update_index i:int i:V i:list V o:list V.
-update_index I V L O :- /* T = [ pr KK _ | VS ] , Cmp KK K eq , std.append F [ (pr K VI) | VS ] M1 */
-  coq.say "split",
-  std.split-at I L F [ _ | T ],
-  !,
-  coq.say "append",
-  std.append F [ V | T ] O.
-/* update_index 0 V [ _ | L ] [ V | L ] :- !.
-update_index N V [ X | L ] [ X | O ] :-
-  NN is N - 1,
-  !,
-  update_index NN V L O,
-  !. */
-
-% [add K V M M1] M1 is M where K is bound to V
-pred add i:K, i:V, i:mymap K V, o:mymap K V.
-add K V (mymap M Cmp) (mymap M1 Cmp) :-
-  std.length M Len,
-  coq.say "Search",
-  binary_search (pr K (_ /* dummy value */)) (cmp_fst_pair Cmp) 0 (Len - 1) M I Approx,
-  if (Approx = tt)
-  (coq.say "Insert", insert_index I (pr K V) M M1) /* insert */
-  (coq.say "Update", update_index I (pr K V) M M1 ) /* update */
-  , coq.say "Done"
-  , !.
-}}.
-
-Elpi Query lp:{{
-  make cmp_term MyMap,
-  coq.say "Empty:" MyMap,
-  add "hello" "24" MyMap UpdatedMap,
-  coq.say "updated map" UpdatedMap,
-  add "hello2" "28" UpdatedMap MoreUpdatedMap,
-  find "hello" MoreUpdatedMap Result.
-}}.
- *)
-
-(* https://github.com/leanprover/lean4/blob/cade21/src/Lean/Meta/SynthInstance.lean *)
-(* https://github.com/LPCIC/coq-elpi/blob/master/builtin-doc/coq-builtin.elpi *)
-(* Tabled type class : https://github.com/purefunctor/tabled-typeclass-resolution?tab=readme-ov-file *)
-(* https://github.com/purefunctor/tabled-typeclass-resolution/blob/main/src/lib.rs *)
-(* ty = https://github.com/leanprover/lean4/blob/cade21/src/Lean/Expr.lean#L152-L165 *)
-(* Coq-Stlc: https://lpcic.github.io/coq-elpi/stlc.txt *)
-(* https://github.com/leanprover/lean4/blob/master/src/Lean/Expr.lean#L302-L512 *)
-Elpi Accumulate lp:{{
-  typeabbrev ty term.
-
-  kind data type.
-  type data ty -> list data -> data.
-
-  kind assertion type.
-  type assertion term -> term -> assertion.
-
-  kind consumer_node type.
-  type consumer_node assertion -> list assertion -> consumer_node.
-
-  kind waiter type.
-  type root waiter.
-  type callback consumer_node -> waiter.
-
-  kind entry type.
-  type entry list waiter -> list assertion -> entry.
-
-  typeabbrev resume_stack (list (pair consumer_node assertion)).
-
-  typeabbrev instance tc-instance.
-
-  kind class_instances type.
-  type class_instances std.map2 assertion (list instance) -> class_instances.
-
-  kind generator_node type.
-  type generator_node assertion -> list instance -> generator_node.
-
-  kind synth type.
-  type synth list generator_node ->
-    resume_stack ->
-    std.map2 assertion entry ->
-    option assertion ->
-    synth.
-}}.
-
-Elpi Accumulate lp:{{
-  pred type_equal i:ty i:ty o:cmp.
-  type_equal X Y Cmp :-
-    ground_term X,
-    ground_term Y,
-    cmp_term X Y Cmp.
-  type_equal X Y eq :- var X, var Y.
-  type_equal (app L) (app G) Cmp :- type_equal_list L G Cmp.
-  type_equal X Y lt :- var X, ground_term Y.
-  type_equal X Y gt :- ground_term X, var Y.
-
-  pred type_equal_list i:list ty i:list ty o:cmp.
-  type_equal_list [ X | XS ] [ Y | YS ] Cmp :-
-      type_equal X Y eq,
-      type_equal_list XS YS Cmp.
-  type_equal_list [ X | _ ] [ Y | _ ] Cmp :-
-      type_equal X Y Cmp,
-      not (Cmp = eq).
-  type_equal_list [] [] eq.
-
-
-  pred assertion_equal i:assertion i:assertion o:cmp.
-  assertion_equal (assertion A _) (assertion B _) Cmp :-
-  /* coq.say {coq.term->string A} "VS" {coq.term->string B}, */
-    type_equal A B Cmp,
-    !
-    /* Deterministic ! */
-    .
-
-  pred term_typeclass i:term o:gref.
-  term_typeclass (global Name) Name.
-  term_typeclass (app [X | _]) N :- term_typeclass X N.
-  term_typeclass (prod X T F) N :-
-    pi x\ term_typeclass (F x) N.
-
-  pred assertion_typeclass i:assertion o:gref.
-  assertion_typeclass (assertion G _) Name :- term_typeclass G Name.
-}}.
-
-Elpi Accumulate lp:{{
-  pred new_subgoal i:synth i:assertion i:waiter o:synth.
-  new_subgoal
-    (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-    Subgoal Waiter
-    (synth NewGeneratorStack ResumeStack NewAssertionTable RootAnswer) :-
-    std.map2.add Subgoal (entry [Waiter] []) AssertionTable NewAssertionTable,
-    assertion_typeclass Subgoal Name,
-    coq.TC.db-for Name Instances,
-    NewGeneratorStack = [(generator_node Subgoal Instances) | GeneratorStack]
-    .
-}}.
-
-(* Apply answer to goal and update meta variable context if it succeeds *)
-Elpi Accumulate lp:{{
-  pred replace_var_term i:ty o:ty i:ty o:ty.
-  replace_var_term X Y (app L) (app G) :-
-    std.map L (replace_var_term X Y) G.
-  replace_var_term X Y Z W :-
-    var Z,
-    X == Z,
-    W = Y
-    .
-  replace_var_term X Y Z Z.
-
-  pred replace_var_in_list i:ty o:ty i:list assertion o:list assertion.
-  replace_var_in_list X Y [ assertion TA VA | AS ] [ assertion TB VB | BS ] :-
-      replace_var_term X Y TA TB,
-      replace_var_term X Y VA VB,
-      replace_var_in_list X Y AS BS.
-  replace_var_in_list _ _ [] [].
-
-  pred try_answer_type i:ty o:ty i:ty o:ty i:list assertion o:list assertion.
-  try_answer_type X Y IX IY Lin Lout :-
-    var X, var Y,
-    replace_var_term X Y IX IY,
-    replace_var_in_list X Y Lin Lout.
-  try_answer_type (app L) (app G) IX IY Lin Lout :-
-    try_answer_type_list L G IX IY Lin Lout.
-  try_answer_type X Y IX IY Lin Lout :-
-    var X, ground_term Y, replace_var_term X Y IX IY, replace_var_in_list X Y Lin Lout.
-  try_answer_type X Y I I L L :-
-    ground_term X,
-    ground_term Y,
-    cmp_term X Y eq.
-
-  pred try_answer_type_list i:list ty o:list ty i:ty o:ty i:list assertion o:list assertion.
-  try_answer_type_list [ X | XS ] [ Y | YS ] IX IY Lin Lout :-
-      try_answer_type X Y IX Itemp Lin Ltemp,
-      try_answer_type_list XS YS Itemp IY Ltemp Lout.
-  try_answer_type_list [] [] I I L L.
-
-  pred try_answer i:assertion o:assertion i:assertion o:assertion i:list assertion o:list assertion.
-  try_answer (assertion A VA) (assertion B VB) (assertion G IA) (assertion G IB) Lin Lout :-
-    try_answer_type A B IA ITemp Lin Lout,
-    replace_var_term VA VB ITemp IB.
-}}.
-
-
-Elpi Accumulate lp:{{
-  pred replace_list i:list term i:term i:term o:list term.
-  replace_list [ A | XS ] A B [ B | YS ] :-
-      !,
-      replace_list XS A B YS.
-  replace_list [ C | XS ] A B [ C | YS ] :-
-      replace_list XS A B YS.
-  replace_list [] _ _ [].
-
-  pred extract_helper i:term i:int i:term o:term.
-  extract_helper X Index (prod N T F) (prod N T G) :-
-    !,
-    pi x\
-      extract_helper X Index (F x) (G x).
-  extract_helper X Index (app L) (app NewL) :-
-    !,
-    std.split-at Index L Lfront [ V | Ltail ],
-    replace_list L V X NewL.
-
-  pred is_var_at_index i:term i:int.
-  is_var_at_index (prod N T F) I :-
-    pi x\
-      is_var_at_index (F x) I.
-  is_var_at_index (app L) I :-
-    std.split-at I L Lfront [ T | Ltail],
-    var T.
-
-  pred extract_variables i:list term i:int o:term.
-    extract_variables L -1 (app L).
-  extract_variables L Index Tm :-
-    PrevIndex is Index - 1,
-    extract_variables L PrevIndex PrevTm,
-    !,
-    ((is_var_at_index PrevTm Index,
-     Tm = prod TmX TmT TmF,
-     pi x\
-       extract_helper x Index PrevTm (TmF x)
-    );
-    (Tm = PrevTm))
-    .
-
-  pred re_generalize i:list term o:list term.
-  re_generalize [ X | Tl ] R :-
-    coq.typecheck X T ok,
-    (
-      (T = (app Tlist),
-       std.length Tlist Len,
-       Index is Len - 1,
-       extract_variables Tlist Index NewR,
-       R = [ NewR | RTl ]
-       );
-      (R = RTl)
-    ),
-    re_generalize Tl RTl
-    .
-  re_generalize [ X | Tl ] [] :-
-    re_generalize Tl R.
-  re_generalize [ ] [].
-}}.
-
-Elpi Accumulate lp:{{
-  pred tc_instance_to_term i:tc-instance o:term.
-  tc_instance_to_term (tc-instance (const C) _) T :-
-    coq.env.const C _ /* Body */ Type,
-    coq.gref->string (const C) _ /* Name */,
-    T = Type.
-
-  pred does_type_resolve i:term o:term.
-  does_type_resolve X Y :-
-    var Y,
-    X = Y.
-  does_type_resolve X Y :-
-    var X.
-  does_type_resolve (app L) (app G) :-
-    std.map L does_type_resolve G.
-  does_type_resolve X Y :-
-    ground_term X,
-    X = Y.
-
-  pred try_resolve_types i:term i:term o:list term o:list assertion.
-  try_resolve_types A (prod X T F) OL L :-
-    coq.typecheck V T ok,
-    try_resolve_types A (F V) OLS LS,
-    (OL = [ V | OLS]),
-    ((T = app _ ; L = [ assertion T V | LS ]) ; (L = LS)) /* TODO : better 'contains instance or var test' */
-    .
-  try_resolve_types A B [] [] :-
-    does_type_resolve A B
-    .
-}}.
-
-Elpi Accumulate lp:{{
-  pred helper_fn i:term o:assertion.
-  helper_fn A (assertion A V).
-
-  pred simpl i:term o:term.
-  simpl (app [ prod X T F , Arg | Tl ]) R :-
-    simpl (app [ (F Arg) | Tl ]) R.
-  simpl (app [ A ]) A.
-  simpl A A.
-
-  pred filter_metavariables i:list assertion o:list assertion.
-  filter_metavariables [ assertion (app L) V | XS ] [ assertion (app L) V | YS ] :-
-      !, filter_metavariables XS YS.
-  filter_metavariables [ assertion X _ | XS ] YS :-
-      filter_metavariables XS YS.
-  filter_metavariables [] [].
-
-
-  pred try_resolve i:assertion i:instance o:assertion o:list assertion.
-  try_resolve (assertion A _) (tc-instance BI _) (assertion RT RV) RL :-
-    tc_instance_to_term (tc-instance BI _) B,
-    coq.env.global BI BITm,
-    coq.gref->string BI BIName,
-    BI = const (BIConst),
-    coq.env.const BIConst (some BIBody) BITy,
-    try_resolve_types A B OL L,
-    filter_metavariables L RL,
-    !,
-    RT = A,
-    ((OL = [], RV = BITm) ; RV = app [ BITm | OL ])
-    .
-}}.
-
-Elpi Accumulate lp:{{
-  pred temp_fun i:consumer_node i:assertion o:(pair consumer_node assertion).
-  temp_fun A B (pr A B).
-
-  pred waiter_fun i:assertion i:assertion i:waiter i:(pair (resume_stack) (option assertion)) o:(pair (resume_stack) (option assertion)).
-  waiter_fun Answer Guess root (pr A _) (pr A (some Answer)).
-  waiter_fun Answer Goal (callback C) (pr A R) (pr [pr C Answer /* Goal */ | A] R).
-
-  pred new_consumer_node i:synth i:assertion i:consumer_node o:synth.
-  new_consumer_node
-      (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-      Answer
-      (consumer_node Goal [])
-      (synth GeneratorStack NewResumeStack NewAssertionTable NewRootAnswer) :-
-    /* for each solution to g, push new cnode onto resume stack with it */
-    std.map2.find Goal AssertionTable (entry Waiters Answers),
-    /* for each solution to g, push new cnode onto resume stack with it */
-    std.fold Waiters (pr ResumeStack RootAnswer) (waiter_fun Answer Goal) (pr NewResumeStack NewRootAnswer),
-    /* add new cnode to g's dependents */
-    coq.say "Update",
-    std.map2.update Goal (entry Waiters [ Answer | Answers ]) AssertionTable NewAssertionTable,
-    coq.say "Done",
-    !.
-
-  new_consumer_node
-      (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-      _
-      (consumer_node _ [ Subgoal | _ ] as CN)
-      (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer) :-
-      /* TODO: Consumer node is general instead of variable or hole */
-      if (std.map2.find Subgoal AssertionTable (entry Waiters Answers))
-         (
-          /* Map answers with consumer node */
-          /* Add cnode onto G's dependents? */
-          std.map Answers (temp_fun CN) TempResumeStack,
-          std.append TempResumeStack ResumeStack NewResumeStack,
-
-          NewWaiters = [ callback CN | Waiters ],
-              /* std.map2.remove Subgoal AssertionTable TempAssertionTable, */
-          std.map2.update Subgoal (entry NewWaiters Answers) AssertionTable NewAssertionTable,
-          NewGeneratorStack = GeneratorStack
-         )
-         (
-          new_subgoal
-            (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-            Subgoal
-            (callback CN)
-            (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer)
-        ),
-        !.
-
-    new_consumer_node _ _ _ _ :- coq.error "Failed new consumer node!" , fail.
-}}.
-
-Elpi Accumulate lp:{{
-  pred tabled_typeclass_resolution_body i:synth i:assertion o:synth o:assertion.
-  tabled_typeclass_resolution_body (synth _ _ _ (some Answer)) _ _ Answer.
-
-  tabled_typeclass_resolution_body
-      (synth GeneratorStack [ (pr (consumer_node Goal [ Subgoal | Remaining ]) Answer) | ResumeStack ]
-       AssertionTable RootAnswer) Query MySynth FinalAnswer :-
-    Answer = assertion AnswerT AnswerV,
-    coq.typecheck AnswerV AnswerNT ok,
-    NewAnswer = assertion AnswerNT AnswerV,
-    if (try_answer Subgoal NewAnswer Goal UpdatedGoal Remaining UpdatedRemaining)
-       (
-        /* TODO: Update Remaining with unification from try_answer ! */
-        new_consumer_node
-         (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-         UpdatedGoal /* TODO: final answer here! */
-         (consumer_node UpdatedGoal UpdatedRemaining) /* TODO: Was Goal in code, but should add new solution? */
-         MySynth
-      )
-      (
-        MySynth = (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-      ).
-
-  tabled_typeclass_resolution_body
-    (synth GeneratorStack [ (pr (consumer_node Goal []) Answer) | ResumeStack ]
-       AssertionTable RootAnswer) Query MySynth FinalAnswer :-
-   coq.warn "Cannot resume with empty subgoals!",
-   fail.
-
-  tabled_typeclass_resolution_body
-    (synth [ generator_node Goal [Instance | Instances ] | GeneratorStack ]
-      ResumeStack AssertionTable RootAnswer) Query NewSynth FinalAnswer :-
-    coq.say "Try",
-    if (try_resolve Goal Instance Resolved Subgoals)
-       (
-         coq.say "YES",
-         /* else (l. 14) */
-         new_consumer_node
-          (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
-          Resolved
-          (consumer_node Resolved Subgoals) NewSynth
-       )
-       (
-         coq.say "NO",
-         /* If first subgoal of cnode does not resolve with solution then Continue */
-         NewSynth = (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
-       ).
-
-  tabled_typeclass_resolution_body
-    (synth [ generator_node _ [] | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
-      Query
-      (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-      FinalAnswer.
-  /* If cnode has no remaining subgoals then (ll.7-13) .. */
-
-  tabled_typeclass_resolution_body (synth [] [] _ _) _ _ _ :- fail.
-}}.
-
-Elpi Accumulate lp:{{
-  pred synth_loop i:synth i:assertion i:int o:assertion.
-  synth_loop (synth _ _ _ (some Answer)) _ Fuel Answer.
-  synth_loop MySynth Query Fuel FinalAnswer :-
-    MySynth = synth Stack1 Stack2 _ _,
-    coq.say "synth round" Fuel,
-    ((Stack1 = [ generator_node (assertion (StkHd1T) (StkHd1V)) L1 | _ ] , coq.say "topG:" {coq.term->string StkHd1T} {coq.term->string StkHd1V} L1); true),
-    ((Stack2 = [ pr (consumer_node (assertion StkHd2T StkHd2V) _) (assertion AnsT AnsV) | _ ] , coq.say "topR:" {coq.term->string StkHd2T} {coq.term->string StkHd2V}, coq.say "answer:" {coq.term->string AnsT} {coq.term->string AnsV}); true),
-    coq.say "",
-    /* coq.say "synth round" Fuel Stack2 Stack1, */
-    Fuel > 0,
-    tabled_typeclass_resolution_body MySynth Query NextSynth FinalAnswer,
-    !,
-    NextFuel is Fuel - 1,
-    coq.say "Copy synth?",
-    synth_loop NextSynth Query NextFuel FinalAnswer.
-
-  pred tabled_typeclass_resolution i:assertion o:assertion.
-  tabled_typeclass_resolution Query FinalAnswer :-
-    std.map2.make assertion_equal AssertionTableEmpty,
-    new_subgoal (synth [] [] AssertionTableEmpty none) Query root MySynth,
-    /* while true do */
-    synth_loop MySynth Query 20000 FinalAnswer,
-    !.
-}}.
-
-Class R1 (X : Type) (Y : Type).
-Axiom A1 B1 C1 D1 : Type.
-Instance I3 : R1 C1 D1 := {}.
-Instance I2 : R1 A1 C1 := {}.
-Instance I1 : R1 A1 B1 := {}.
-Instance I4 {X Y Z} `(R1 X Y) `(R1 Y Z) : R1 X Z := { }.
-
-(* Trivial Example *)
-Elpi Query lp:{{
-  MyGoal = {{ R1 A1 B1 }},
-  tabled_typeclass_resolution (assertion MyGoal {{ lib:elpi.hole }}) (assertion FinalType FinalAnswer),
-  FinalType = MyGoal,
-  coq.say "FinalAnswer" FinalType FinalAnswer,
-  coq.typecheck FinalAnswer MyGoal ok.
-}}.
-
-(* Instance TestRAB : R1 A1 B1 := _. *)
-
-(* Example from Paper: Tabled Typeclass Resolution *)
-Elpi Query lp:{{
-  MyGoal = {{ R1 A1 D1 }},
-  coq.say "MyGoal" (assertion MyGoal {{ lib:elpi.hole }}),
-  tabled_typeclass_resolution (assertion MyGoal {{ lib:elpi.hole }}) (assertion FinalType FinalAnswer),
-  !,
-  coq.say "FinalAnswer" FinalType FinalAnswer "vs" {{ @I4 A1 C1 D1 I2 I3 }} {{ I4 I2 I3 }},
-  FinalType = MyGoal,
-  coq.say "Typechecks?",
-  coq.typecheck FinalAnswer MyGoal ok,
-  coq.say "Final Ground?",
-  ground_term FinalAnswer.
-}}.
-
-Elpi Accumulate lp:{{
-  pred proof_search i:list gref i:list tc-instance i:term o:term.
-  proof_search Typeclasses [tc-instance Hd _ | _ ] Type PRoof :-
-    coq.env.typeof Hd TypeRes,
-    coq.env.global Hd ProofRes,
-    coq.say "CHECKING" TypeRes,
-    coq.unify-eq TypeRes Type D,
-    coq.say D,
-    D = ok,
-    % TypeRes = Type,
-    coq.say "SUCCESS",
-    PRoof = ProofRes.
-  proof_search Typeclasses [_|Tl] Type PRoof :-
-    proof_search Typeclasses Tl Type PRoof.
-}}.
-
-Elpi Accumulate lp:{{
-  pred tabled_proof_search i:list gref i:term o:term.
-  tabled_proof_search Typeclasses Type PRoof :-
-    coq.say "TYPECLASSES" Typeclasses,
-    MyGoal = assertion Type {{ _ }},
-    tabled_typeclass_resolution MyGoal FinalAnswer,
-    !,
-
-    /* Convert from result to proof term! */
-
-    FinalAnswer = assertion FinalType FinalTerm,
-    FinalProof = FinalTerm,
-    coq.say "FinalProof" {coq.term->string FinalProof},
-    PRoof = FinalProof,
-    coq.say "Proof" {coq.term->string PRoof} "Done"
-    .
-
-
-  pred search_context i:list prop i:term o:term.
-  search_context [decl Te N Ty | _] Type PRoof :-
-    Ty = Type,
-    Te = PRoof,
-    coq.say "CHECK SUCC" N PRoof.
-  search_context [_|Tl] Type PRoof :- search_context Tl Type PRoof.
-
-  solve (goal Ctx Trigger Type PRoof Args as G) V :-
-    coq.TC.db-tc Typeclasses,
-    coq.say "AGRS" Args Ctx,
-    coq.say "SEARCHING ..." {coq.term->string Type}, !,
-    coq.say "V" V,
-    (search_context Ctx Type PRoof ; tabled_proof_search Typeclasses Type PRoof),
-    coq.say "SUCCESS FINDING INSTANCE".
-
-
-  solve _ _ :- coq.ltac.fail _ "No auto".
-}}.
-
-(*
-Elpi TC Solver Activate TC.TabledSolver.
-Elpi TC Solver Override TC.TabledSolver All.
- *)
+From elpi.apps.tc_tabled.elpi Extra Dependency "tabled_type_class.elpi" as TabledTC.
+Elpi Accumulate File TabledTC.
 
 Elpi Export TC.TabledSolver.

From 0ddde3eda7a3523de9fcd48e13462261a073253a Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Tue, 12 Aug 2025 23:03:31 +0200
Subject: [PATCH 16/23] Maps seem to copy incorrectly?

---
 apps/tc-tabled/elpi/tabled_type_class.elpi | 825 +++++++++++----------
 apps/tc-tabled/elpi/test.elpi              |   1 -
 apps/tc-tabled/theories/diamond.v          |   4 +-
 3 files changed, 418 insertions(+), 412 deletions(-)
 delete mode 100644 apps/tc-tabled/elpi/test.elpi

diff --git a/apps/tc-tabled/elpi/tabled_type_class.elpi b/apps/tc-tabled/elpi/tabled_type_class.elpi
index 86408d2e2..2bcfbc486 100644
--- a/apps/tc-tabled/elpi/tabled_type_class.elpi
+++ b/apps/tc-tabled/elpi/tabled_type_class.elpi
@@ -22,10 +22,9 @@ namespace std.map2 {
 pred make i:(pred i:K, i:K, o:cmp), o:std.map2 K V.
 make Cmp (std.map2 private.empty Cmp).
 
-
 % [find K M V] looks in M for the value V associated to K
 pred find i:K, i:std.map2 K V, o:V.
-find K (std.map2 M Cmp) V :- 
+find K (std.map2 M Cmp) V :-
   coq.say "Find",
   private.find M Cmp K V,
   coq.say "FY".
@@ -33,12 +32,12 @@ find _ _ _ :- coq.say "FN", fail.
 
 % [add K V M M1] M1 is M where K is bound to V
 pred add i:K, i:V, i:std.map2 K V, o:std.map2 K V.
-add K V (std.map2 M Cmp) (std.map2 M1 Cmp) :- 
+add K V (std.map2 M Cmp) (std.map2 M1 Cmp) :-
   private.add M Cmp K V M1.
 
 % [update K V M M1] M1 is M where K is bound to V
 pred update i:K, i:V, i:std.map2 K V, o:std.map2 K V.
-update K V (std.map2 M Cmp) (std.map2 M1 Cmp) :- 
+update K V (std.map2 M Cmp) (std.map2 M1 Cmp) :-
   private.update M Cmp K V M1.
 
 % [remove K M M1] M1 is M where K is unbound
@@ -64,7 +63,7 @@ pred create i:map K V, i:K, i:V, i:map K V, o:map K V.
 create L K V R (node L K V R H) :- H is {std.max {height L} {height R} } + 1.
 
 pred print_m i:(map K V) o:string.
-print_m (empty) "emtpy". 
+print_m (empty) "emtpy".
 print_m (node L _ _ R I) S :-
   print_m L SL,
   print_m R SR,
@@ -99,24 +98,24 @@ add empty _ K V T :- create empty K V empty T.
 add (node _ X _ _ _ as M) Cmp X1 XD M1 :- Cmp X1 X E, !, add.aux E M Cmp X1 XD M1.
 
 pred add.aux i:cmp, i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
-add.aux eq (node L _ _ R H) _   X XD T :- T = node L X XD R H, !. 
+add.aux eq (node L _ _ R H) _   X XD T :- T = node L X XD R H, !.
 add.aux lt (node L V D R _) Cmp X XD T :- bal {add L Cmp X XD} V D R T, !.
 add.aux gt (node L V D R _) Cmp X XD T :- bal L V D {add R Cmp X XD} T, !.
 
 pred update i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
-update (node _ X _ _ _ as M) Cmp X1 XD M1 :- 
+update (node _ X _ _ _ as M) Cmp X1 XD M1 :-
   !, Cmp X1 X E, !, update.aux E M Cmp X1 XD M1, !.
 
 pred update.aux i:cmp, i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
-update.aux eq (node L _ _ R H) _   X XD T :- 
-  T = node L X XD R H, !. 
-update.aux lt (node L V D R H) Cmp X XD T :- 
+update.aux eq (node L _ _ R H) _   X XD T :-
+  T = node L X XD R H, !.
+update.aux lt (node L V D R H) Cmp X XD T :-
   T = node {update L Cmp X XD} V D R H, !.
-update.aux gt (node L V D R H) Cmp X XD T :- 
+update.aux gt (node L V D R H) Cmp X XD T :-
   T = node L V D {update R Cmp X XD} H, !.
 
 pred find i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:V.
-find ((node L K1 V1 R _) as M) Cmp K V :- 
+find ((node L K1 V1 R _) as M) Cmp K V :-
   Cmp K K1 E, find.aux E Cmp L R V1 K V.
 
 pred find.aux i:cmp, i:(pred i:K, i:K, o:cmp), i:map K V, i:map K V, i:V, i:K, o:V.
@@ -157,58 +156,48 @@ bindings (node L V D R _) X X1 :-
 } % std.map2.private
 } % std.map2
 
+kind custom_map type -> type -> type.
+type custom_map list (pair K V) -> (pred i:K i:K o:cmp) -> custom_map K V.
 
-
-kind mymap type -> type -> type.
-type mymap list (pair K V) -> (pred i:K i:K o:cmp) -> mymap K V.
-
-% [make Eq Ltn M] builds an empty map M where keys are compared using Eq and Ltn
-pred make i:(pred i:K, i:K, o:cmp), o:mymap K V.
-make Cmp (mymap [] Cmp).
+pred custom_make i:(pred i:K, i:K, o:cmp), o:custom_map K V.
+custom_make Cmp (custom_map [] Cmp).
 
 pred cmp_fst_pair i:(pred i:K i:K o:cmp) i:pair K V i:pair K V o:cmp.
 cmp_fst_pair Cmp (pr K1 _) (pr K2 _) C :- Cmp K1 K2 C.
 
-% [find K M V] looks in M for the value V associated to K
-pred find i:K, i:mymap K V, o:V.
-find K (mymap M Cmp) V :-
-  coq.say "Find",
+pred custom_find i:K, i:custom_map K V, o:V.
+custom_find K (custom_map M Cmp) V :-
   std.length M Len,
   binary_search (pr K (_ /* dummy value */)) (cmp_fst_pair Cmp) 0 (Len - 1) M I ff,
   !,
   std.nth I M (pr KK V),
   Cmp KK K eq,
-  !,
-  coq.say "FY".
-find _ _ _ :- coq.say "FN", fail.
+  !.
 
 pred insert_index i:int i:V i:list V o:list V.
-insert_index I V L O :- /* std.append F [ (pr K VI) | T  ] M1 */
-  std.split-at I L F T,
-  !,
-  std.append F [ V | T ] O.
-/* insert_index 0 V L [ V | L ].
+%% insert_index I V L O :- /* std.append F [ (pr K VI) | T  ] M1 */
+%%   std.split-at I L F T,
+%%   !,
+%%   std.append F [ V | T ] O.
+insert_index 0 V L [ V | L ].
 insert_index N V [ X | L ] [ X | O ] :-
   NN is N - 1,
-  insert_index NN V L O. */
+  insert_index NN V L O.
 
 pred update_index i:int i:V i:list V o:list V.
-update_index I V L O :- /* T = [ pr KK _ | VS ] , Cmp KK K eq , std.append F [ (pr K VI) | VS ] M1 */
-  coq.say "split",
-  std.split-at I L F [ _ | T ],
-  !,
-  coq.say "append",
-  std.append F [ V | T ] O.
-/* update_index 0 V [ _ | L ] [ V | L ] :- !.
+%% update_index I V L O :- /* T = [ pr KK _ | VS ] , Cmp KK K eq , std.append F [ (pr K VI) | VS ] M1 */
+%%   std.split-at I L F [ _ | T ],
+%%   !,
+%%   std.append F [ V | T ] O.
+update_index 0 V [ _ | L ] [ V | L ] :- !.
 update_index N V [ X | L ] [ X | O ] :-
   NN is N - 1,
   !,
   update_index NN V L O,
-  !. */
+  !.
 
-% [add K V M M1] M1 is M where K is bound to V
-pred add i:K, i:V, i:mymap K V, o:mymap K V.
-add K V (mymap M Cmp) (mymap M1 Cmp) :-
+pred custom_add i:K, i:V, i:custom_map K V, o:custom_map K V.
+custom_add K V (custom_map M Cmp) (custom_map M1 Cmp) :-
   std.length M Len,
   coq.say "Search",
   binary_search (pr K (_ /* dummy value */)) (cmp_fst_pair Cmp) 0 (Len - 1) M I Approx,
@@ -218,6 +207,25 @@ add K V (mymap M Cmp) (mymap M1 Cmp) :-
   , coq.say "Done"
   , !.
 
+pred mymap_make i:(pred i:K, i:K, o:cmp), o:mymap K V.
+pred mymap_find i:K i:(mymap K V) o:V.
+pred mymap_add i:K i:V i:(mymap K V) o:(mymap K V).
+pred mymap_update i:K i:V i:(mymap K V) o:(mymap K V).
+
+%% typeabbrev (mymap K V) (custom_map K V).
+
+%% mymap_make Cmp M :- custom_make Cmp M.
+%% mymap_find K M V :- custom_find K M V.
+%% mymap_add K V M M1 :- custom_add K V M M1.
+%% mymap_update K V M M1 :- custom_add K V M M1.
+
+typeabbrev (mymap K V) (std.map2 K V).
+
+mymap_make Cmp M :- std.map2.make Cmp M.
+mymap_find K M V :- std.map2.find K M V.
+mymap_add K V M M1 :- std.map2.add K V M M1.
+mymap_update K V M M1 :- std.map2.update K V M M1.
+
 /*
 (* https://github.com/leanprover/lean4/blob/cade21/src/Lean/Meta/SynthInstance.lean *)
 (* https://github.com/LPCIC/coq-elpi/blob/master/builtin-doc/coq-builtin.elpi *)
@@ -228,428 +236,427 @@ add K V (mymap M Cmp) (mymap M1 Cmp) :-
 (* https://github.com/leanprover/lean4/blob/master/src/Lean/Expr.lean#L302-L512 *)
 */
 
-  typeabbrev ty term.
-
-  kind data type.
-  type data ty -> list data -> data.
+typeabbrev ty term.
 
-  kind assertion type.
-  type assertion term -> term -> assertion.
+kind data type.
+type data ty -> list data -> data.
 
-  kind consumer_node type.
-  type consumer_node assertion -> list assertion -> consumer_node.
+kind assertion type.
+type assertion term -> term -> assertion.
 
-  kind waiter type.
-  type root waiter.
-  type callback consumer_node -> waiter.
+kind consumer_node type.
+type consumer_node assertion -> list assertion -> consumer_node.
 
-  kind entry type.
-  type entry list waiter -> list assertion -> entry.
+kind waiter type.
+type root waiter.
+type callback consumer_node -> waiter.
 
-  typeabbrev resume_stack (list (pair consumer_node assertion)).
+kind entry type.
+type entry list waiter -> list assertion -> entry.
 
-  typeabbrev instance tc-instance.
+typeabbrev resume_stack (list (pair consumer_node assertion)).
 
-  kind class_instances type.
-  type class_instances std.map2 assertion (list instance) -> class_instances.
+typeabbrev instance tc-instance.
 
-  kind generator_node type.
-  type generator_node assertion -> list instance -> generator_node.
+kind class_instances type.
+type class_instances mymap assertion (list instance) -> class_instances.
 
-  kind synth type.
-  type synth list generator_node ->
-    resume_stack ->
-    std.map2 assertion entry ->
-    option assertion ->
-    synth.
+kind generator_node type.
+type generator_node assertion -> list instance -> generator_node.
 
-  pred type_equal i:ty i:ty o:cmp.
-  type_equal X Y Cmp :-
-    ground_term X,
-    ground_term Y,
-    cmp_term X Y Cmp.
-  type_equal X Y eq :- var X, var Y.
-  type_equal (app L) (app G) Cmp :- type_equal_list L G Cmp.
-  type_equal X Y lt :- var X, ground_term Y.
-  type_equal X Y gt :- ground_term X, var Y.
+kind synth type.
+type synth list generator_node ->
+  resume_stack ->
+  mymap assertion entry ->
+  option assertion ->
+  synth.
 
-  pred type_equal_list i:list ty i:list ty o:cmp.
-  type_equal_list [ X | XS ] [ Y | YS ] Cmp :-
-      type_equal X Y eq,
-      type_equal_list XS YS Cmp.
-  type_equal_list [ X | _ ] [ Y | _ ] Cmp :-
-      type_equal X Y Cmp,
-      not (Cmp = eq).
-  type_equal_list [] [] eq.
+pred type_equal i:ty i:ty o:cmp.
+type_equal X Y Cmp :-
+  ground_term X,
+  ground_term Y,
+  cmp_term X Y Cmp.
+type_equal X Y eq :- var X, var Y.
+type_equal (app L) (app G) Cmp :- type_equal_list L G Cmp.
+type_equal X Y lt :- var X, ground_term Y.
+type_equal X Y gt :- ground_term X, var Y.
 
+pred type_equal_list i:list ty i:list ty o:cmp.
+type_equal_list [ X | XS ] [ Y | YS ] Cmp :-
+    type_equal X Y eq,
+    type_equal_list XS YS Cmp.
+type_equal_list [ X | _ ] [ Y | _ ] Cmp :-
+    type_equal X Y Cmp,
+    not (Cmp = eq).
+type_equal_list [] [] eq.
 
-  pred assertion_equal i:assertion i:assertion o:cmp.
-  assertion_equal (assertion A _) (assertion B _) Cmp :-
-  /* coq.say {coq.term->string A} "VS" {coq.term->string B}, */
-    type_equal A B Cmp,
-    !
-    /* Deterministic ! */
-    .
 
-  pred term_typeclass i:term o:gref.
-  term_typeclass (global Name) Name.
-  term_typeclass (app [X | _]) N :- term_typeclass X N.
-  term_typeclass (prod X T F) N :-
-    pi x\ term_typeclass (F x) N.
-
-  pred assertion_typeclass i:assertion o:gref.
-  assertion_typeclass (assertion G _) Name :- term_typeclass G Name.
+pred assertion_equal i:assertion i:assertion o:cmp.
+assertion_equal (assertion A _) (assertion B _) Cmp :-
+/* coq.say {coq.term->string A} "VS" {coq.term->string B}, */
+  type_equal A B Cmp,
+  !
+  /* Deterministic ! */
+  .
 
-  pred new_subgoal i:synth i:assertion i:waiter o:synth.
-  new_subgoal
-    (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-    Subgoal Waiter
-    (synth NewGeneratorStack ResumeStack NewAssertionTable RootAnswer) :-
-    std.map2.add Subgoal (entry [Waiter] []) AssertionTable NewAssertionTable,
-    assertion_typeclass Subgoal Name,
-    coq.TC.db-for Name Instances,
-    NewGeneratorStack = [(generator_node Subgoal Instances) | GeneratorStack]
-    .
+pred term_typeclass i:term o:gref.
+term_typeclass (global Name) Name.
+term_typeclass (app [X | _]) N :- term_typeclass X N.
+term_typeclass (prod X T F) N :-
+  pi x\ term_typeclass (F x) N.
+
+pred assertion_typeclass i:assertion o:gref.
+assertion_typeclass (assertion G _) Name :- term_typeclass G Name.
+
+pred new_subgoal i:synth i:assertion i:waiter o:synth.
+new_subgoal
+  (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+  Subgoal Waiter
+  (synth NewGeneratorStack ResumeStack NewAssertionTable RootAnswer) :-
+  mymap_add Subgoal (entry [Waiter] []) AssertionTable NewAssertionTable,
+  assertion_typeclass Subgoal Name,
+  coq.TC.db-for Name Instances,
+  NewGeneratorStack = [(generator_node Subgoal Instances) | GeneratorStack]
+  .
 
 /* Apply answer to goal and update meta variable context if it succeeds */
 
-  pred replace_var_term i:ty o:ty i:ty o:ty.
-  replace_var_term X Y (app L) (app G) :-
-    std.map L (replace_var_term X Y) G.
-  replace_var_term X Y Z W :-
-    var Z,
-    X == Z,
-    W = Y
-    .
-  replace_var_term X Y Z Z.
-
-  pred replace_var_in_list i:ty o:ty i:list assertion o:list assertion.
-  replace_var_in_list X Y [ assertion TA VA | AS ] [ assertion TB VB | BS ] :-
-      replace_var_term X Y TA TB,
-      replace_var_term X Y VA VB,
-      replace_var_in_list X Y AS BS.
-  replace_var_in_list _ _ [] [].
-
-  pred try_answer_type i:ty o:ty i:ty o:ty i:list assertion o:list assertion.
-  try_answer_type X Y IX IY Lin Lout :-
-    var X, var Y,
-    replace_var_term X Y IX IY,
-    replace_var_in_list X Y Lin Lout.
-  try_answer_type (app L) (app G) IX IY Lin Lout :-
-    try_answer_type_list L G IX IY Lin Lout.
-  try_answer_type X Y IX IY Lin Lout :-
-    var X, ground_term Y, replace_var_term X Y IX IY, replace_var_in_list X Y Lin Lout.
-  try_answer_type X Y I I L L :-
-    ground_term X,
-    ground_term Y,
-    cmp_term X Y eq.
-
-  pred try_answer_type_list i:list ty o:list ty i:ty o:ty i:list assertion o:list assertion.
-  try_answer_type_list [ X | XS ] [ Y | YS ] IX IY Lin Lout :-
-      try_answer_type X Y IX Itemp Lin Ltemp,
-      try_answer_type_list XS YS Itemp IY Ltemp Lout.
-  try_answer_type_list [] [] I I L L.
-
-  pred try_answer i:assertion o:assertion i:assertion o:assertion i:list assertion o:list assertion.
-  try_answer (assertion A VA) (assertion B VB) (assertion G IA) (assertion G IB) Lin Lout :-
-    try_answer_type A B IA ITemp Lin Lout,
-    replace_var_term VA VB ITemp IB.
-
-  pred replace_list i:list term i:term i:term o:list term.
-  replace_list [ A | XS ] A B [ B | YS ] :-
-      !,
-      replace_list XS A B YS.
-  replace_list [ C | XS ] A B [ C | YS ] :-
-      replace_list XS A B YS.
-  replace_list [] _ _ [].
-
-  pred extract_helper i:term i:int i:term o:term.
-  extract_helper X Index (prod N T F) (prod N T G) :-
-    !,
-    pi x\
-      extract_helper X Index (F x) (G x).
-  extract_helper X Index (app L) (app NewL) :-
-    !,
-    std.split-at Index L Lfront [ V | Ltail ],
-    replace_list L V X NewL.
-
-  pred is_var_at_index i:term i:int.
-  is_var_at_index (prod N T F) I :-
-    pi x\
-      is_var_at_index (F x) I.
-  is_var_at_index (app L) I :-
-    std.split-at I L Lfront [ T | Ltail],
-    var T.
-
-  pred extract_variables i:list term i:int o:term.
-    extract_variables L -1 (app L).
-  extract_variables L Index Tm :-
-    PrevIndex is Index - 1,
-    extract_variables L PrevIndex PrevTm,
+pred replace_var_term i:ty o:ty i:ty o:ty.
+replace_var_term X Y (app L) (app G) :-
+  std.map L (replace_var_term X Y) G.
+replace_var_term X Y Z W :-
+  var Z,
+  X == Z,
+  W = Y
+  .
+replace_var_term X Y Z Z.
+
+pred replace_var_in_list i:ty o:ty i:list assertion o:list assertion.
+replace_var_in_list X Y [ assertion TA VA | AS ] [ assertion TB VB | BS ] :-
+    replace_var_term X Y TA TB,
+    replace_var_term X Y VA VB,
+    replace_var_in_list X Y AS BS.
+replace_var_in_list _ _ [] [].
+
+pred try_answer_type i:ty o:ty i:ty o:ty i:list assertion o:list assertion.
+try_answer_type X Y IX IY Lin Lout :-
+  var X, var Y,
+  replace_var_term X Y IX IY,
+  replace_var_in_list X Y Lin Lout.
+try_answer_type (app L) (app G) IX IY Lin Lout :-
+  try_answer_type_list L G IX IY Lin Lout.
+try_answer_type X Y IX IY Lin Lout :-
+  var X, ground_term Y, replace_var_term X Y IX IY, replace_var_in_list X Y Lin Lout.
+try_answer_type X Y I I L L :-
+  ground_term X,
+  ground_term Y,
+  cmp_term X Y eq.
+
+pred try_answer_type_list i:list ty o:list ty i:ty o:ty i:list assertion o:list assertion.
+try_answer_type_list [ X | XS ] [ Y | YS ] IX IY Lin Lout :-
+    try_answer_type X Y IX Itemp Lin Ltemp,
+    try_answer_type_list XS YS Itemp IY Ltemp Lout.
+try_answer_type_list [] [] I I L L.
+
+pred try_answer i:assertion o:assertion i:assertion o:assertion i:list assertion o:list assertion.
+try_answer (assertion A VA) (assertion B VB) (assertion G IA) (assertion G IB) Lin Lout :-
+  try_answer_type A B IA ITemp Lin Lout,
+  replace_var_term VA VB ITemp IB.
+
+pred replace_list i:list term i:term i:term o:list term.
+replace_list [ A | XS ] A B [ B | YS ] :-
     !,
-    ((is_var_at_index PrevTm Index,
-     Tm = prod TmX TmT TmF,
-     pi x\
-       extract_helper x Index PrevTm (TmF x)
-    );
-    (Tm = PrevTm))
-    .
+    replace_list XS A B YS.
+replace_list [ C | XS ] A B [ C | YS ] :-
+    replace_list XS A B YS.
+replace_list [] _ _ [].
 
-  pred re_generalize i:list term o:list term.
-  re_generalize [ X | Tl ] R :-
-    coq.typecheck X T ok,
-    (
-      (T = (app Tlist),
-       std.length Tlist Len,
-       Index is Len - 1,
-       extract_variables Tlist Index NewR,
-       R = [ NewR | RTl ]
-       );
-      (R = RTl)
-    ),
-    re_generalize Tl RTl
-    .
-  re_generalize [ X | Tl ] [] :-
-    re_generalize Tl R.
-  re_generalize [ ] [].
-
-  pred tc_instance_to_term i:tc-instance o:term.
-  tc_instance_to_term (tc-instance (const C) _) T :-
-    coq.env.const C _ /* Body */ Type,
-    coq.gref->string (const C) _ /* Name */,
-    T = Type.
-
-  pred does_type_resolve i:term o:term.
-  does_type_resolve X Y :-
-    var Y,
-    X = Y.
-  does_type_resolve X Y :-
-    var X.
-  does_type_resolve (app L) (app G) :-
-    std.map L does_type_resolve G.
-  does_type_resolve X Y :-
-    ground_term X,
-    X = Y.
-
-  pred try_resolve_types i:term i:term o:list term o:list assertion.
-  try_resolve_types A (prod X T F) OL L :-
-    coq.typecheck V T ok,
-    try_resolve_types A (F V) OLS LS,
-    (OL = [ V | OLS]),
-    ((T = app _ ; L = [ assertion T V | LS ]) ; (L = LS)) /* TODO : better 'contains instance or var test' */
+pred extract_helper i:term i:int i:term o:term.
+extract_helper X Index (prod N T F) (prod N T G) :-
+  !,
+  pi x\
+    extract_helper X Index (F x) (G x).
+extract_helper X Index (app L) (app NewL) :-
+  !,
+  std.split-at Index L Lfront [ V | Ltail ],
+  replace_list L V X NewL.
+
+pred is_var_at_index i:term i:int.
+is_var_at_index (prod N T F) I :-
+  pi x\
+    is_var_at_index (F x) I.
+is_var_at_index (app L) I :-
+  std.split-at I L Lfront [ T | Ltail],
+  var T.
+
+pred extract_variables i:list term i:int o:term.
+  extract_variables L -1 (app L).
+extract_variables L Index Tm :-
+  PrevIndex is Index - 1,
+  extract_variables L PrevIndex PrevTm,
+  !,
+  ((is_var_at_index PrevTm Index,
+   Tm = prod TmX TmT TmF,
+   pi x\
+     extract_helper x Index PrevTm (TmF x)
+  );
+  (Tm = PrevTm))
+  .
+
+pred re_generalize i:list term o:list term.
+re_generalize [ X | Tl ] R :-
+  coq.typecheck X T ok,
+  (
+    (T = (app Tlist),
+     std.length Tlist Len,
+     Index is Len - 1,
+     extract_variables Tlist Index NewR,
+     R = [ NewR | RTl ]
+     );
+    (R = RTl)
+  ),
+  re_generalize Tl RTl
+  .
+re_generalize [ X | Tl ] [] :-
+  re_generalize Tl R.
+re_generalize [ ] [].
+
+pred tc_instance_to_term i:tc-instance o:term.
+tc_instance_to_term (tc-instance (const C) _) T :-
+  coq.env.const C _ /* Body */ Type,
+  coq.gref->string (const C) _ /* Name */,
+  T = Type.
+
+pred does_type_resolve i:term o:term.
+does_type_resolve X Y :-
+  var Y,
+  X = Y.
+does_type_resolve X Y :-
+  var X.
+does_type_resolve (app L) (app G) :-
+  std.map L does_type_resolve G.
+does_type_resolve X Y :-
+  ground_term X,
+  X = Y.
+
+pred try_resolve_types i:term i:term o:list term o:list assertion.
+try_resolve_types A (prod X T F) OL L :-
+  coq.typecheck V T ok,
+  try_resolve_types A (F V) OLS LS,
+  (OL = [ V | OLS]),
+  ((T = app _ ; L = [ assertion T V | LS ]) ; (L = LS)) /* TODO : better 'contains instance or var test' */
     .
-  try_resolve_types A B [] [] :-
-    does_type_resolve A B
+try_resolve_types A B [] [] :-
+  does_type_resolve A B
     .
 
-  pred helper_fn i:term o:assertion.
-  helper_fn A (assertion A V).
-
-  pred simpl i:term o:term.
-  simpl (app [ prod X T F , Arg | Tl ]) R :-
-    simpl (app [ (F Arg) | Tl ]) R.
-  simpl (app [ A ]) A.
-  simpl A A.
-
-  pred filter_metavariables i:list assertion o:list assertion.
-  filter_metavariables [ assertion (app L) V | XS ] [ assertion (app L) V | YS ] :-
-      !, filter_metavariables XS YS.
-  filter_metavariables [ assertion X _ | XS ] YS :-
-      filter_metavariables XS YS.
-  filter_metavariables [] [].
-
-
-  pred try_resolve i:assertion i:instance o:assertion o:list assertion.
-  try_resolve (assertion A _) (tc-instance BI _) (assertion RT RV) RL :-
-    tc_instance_to_term (tc-instance BI _) B,
-    coq.env.global BI BITm,
-    coq.gref->string BI BIName,
-    BI = const (BIConst),
-    coq.env.const BIConst (some BIBody) BITy,
-    try_resolve_types A B OL L,
-    filter_metavariables L RL,
+pred helper_fn i:term o:assertion.
+helper_fn A (assertion A V).
+
+pred simpl i:term o:term.
+simpl (app [ prod X T F , Arg | Tl ]) R :-
+  simpl (app [ (F Arg) | Tl ]) R.
+simpl (app [ A ]) A.
+simpl A A.
+
+pred filter_metavariables i:list assertion o:list assertion.
+filter_metavariables [ assertion (app L) V | XS ] [ assertion (app L) V | YS ] :-
+    !, filter_metavariables XS YS.
+filter_metavariables [ assertion X _ | XS ] YS :-
+    filter_metavariables XS YS.
+filter_metavariables [] [].
+
+
+pred try_resolve i:assertion i:instance o:assertion o:list assertion.
+try_resolve (assertion A _) (tc-instance BI _) (assertion RT RV) RL :-
+  tc_instance_to_term (tc-instance BI _) B,
+  coq.env.global BI BITm,
+  coq.gref->string BI BIName,
+  BI = const (BIConst),
+  coq.env.const BIConst (some BIBody) BITy,
+  try_resolve_types A B OL L,
+  filter_metavariables L RL,
     !,
-    RT = A,
-    ((OL = [], RV = BITm) ; RV = app [ BITm | OL ])
+  RT = A,
+  ((OL = [], RV = BITm) ; RV = app [ BITm | OL ])
     .
 
-  pred temp_fun i:consumer_node i:assertion o:(pair consumer_node assertion).
-  temp_fun A B (pr A B).
-
-  pred waiter_fun i:assertion i:assertion i:waiter i:(pair (resume_stack) (option assertion)) o:(pair (resume_stack) (option assertion)).
-  waiter_fun Answer Guess root (pr A _) (pr A (some Answer)).
-  waiter_fun Answer Goal (callback C) (pr A R) (pr [pr C Answer /* Goal */ | A] R).
-
-  pred new_consumer_node i:synth i:assertion i:consumer_node o:synth.
-  new_consumer_node
-      (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-      Answer
-      (consumer_node Goal [])
-      (synth GeneratorStack NewResumeStack NewAssertionTable NewRootAnswer) :-
-    /* for each solution to g, push new cnode onto resume stack with it */
-    std.map2.find Goal AssertionTable (entry Waiters Answers),
-    /* for each solution to g, push new cnode onto resume stack with it */
-    std.fold Waiters (pr ResumeStack RootAnswer) (waiter_fun Answer Goal) (pr NewResumeStack NewRootAnswer),
-    /* add new cnode to g's dependents */
-    coq.say "Update",
-    std.map2.update Goal (entry Waiters [ Answer | Answers ]) AssertionTable NewAssertionTable,
-    coq.say "Done",
+pred temp_fun i:consumer_node i:assertion o:(pair consumer_node assertion).
+temp_fun A B (pr A B).
+
+pred waiter_fun i:assertion i:assertion i:waiter i:(pair (resume_stack) (option assertion)) o:(pair (resume_stack) (option assertion)).
+waiter_fun Answer Guess root (pr A _) (pr A (some Answer)).
+waiter_fun Answer Goal (callback C) (pr A R) (pr [pr C Answer /* Goal */ | A] R).
+
+pred new_consumer_node i:synth i:assertion i:consumer_node o:synth.
+new_consumer_node
+    (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+    Answer
+    (consumer_node Goal [])
+    (synth GeneratorStack NewResumeStack NewAssertionTable NewRootAnswer) :-
+  /* for each solution to g, push new cnode onto resume stack with it */
+  mymap_find Goal AssertionTable (entry Waiters Answers),
+  /* for each solution to g, push new cnode onto resume stack with it */
+  std.fold Waiters (pr ResumeStack RootAnswer) (waiter_fun Answer Goal) (pr NewResumeStack NewRootAnswer),
+  /* add new cnode to g's dependents */
+  coq.say "Update",
+  mymap_update Goal (entry Waiters [ Answer | Answers ]) AssertionTable NewAssertionTable,
+  coq.say "Done",
     !.
 
-  new_consumer_node
-      (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+new_consumer_node
+    (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
       _
-      (consumer_node _ [ Subgoal | _ ] as CN)
-      (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer) :-
-      /* TODO: Consumer node is general instead of variable or hole */
-      if (std.map2.find Subgoal AssertionTable (entry Waiters Answers))
+    (consumer_node _ [ Subgoal | _ ] as CN)
+    (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer) :-
+    /* TODO: Consumer node is general instead of variable or hole */
+    if (mymap_find Subgoal AssertionTable (entry Waiters Answers))
          (
-          /* Map answers with consumer node */
-          /* Add cnode onto G's dependents? */
-          std.map Answers (temp_fun CN) TempResumeStack,
-          std.append TempResumeStack ResumeStack NewResumeStack,
-
-          NewWaiters = [ callback CN | Waiters ],
-              /* std.map2.remove Subgoal AssertionTable TempAssertionTable, */
-          std.map2.update Subgoal (entry NewWaiters Answers) AssertionTable NewAssertionTable,
-          NewGeneratorStack = GeneratorStack
+        /* Map answers with consumer node */
+        /* Add cnode onto G's dependents? */
+        std.map Answers (temp_fun CN) TempResumeStack,
+        std.append TempResumeStack ResumeStack NewResumeStack,
+
+        NewWaiters = [ callback CN | Waiters ],
+        mymap_update Subgoal (entry NewWaiters Answers) AssertionTable NewAssertionTable,
+        NewGeneratorStack = GeneratorStack
          )
          (
-          new_subgoal
-            (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-            Subgoal
-            (callback CN)
-            (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer)
+        new_subgoal
+          (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+          Subgoal
+          (callback CN)
+          (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer)
         ),
         !.
 
-    new_consumer_node _ _ _ _ :- coq.error "Failed new consumer node!" , fail.
+  new_consumer_node _ _ _ _ :- coq.error "Failed new consumer node!" , fail.
 
-  pred tabled_typeclass_resolution_body i:synth i:assertion o:synth o:assertion.
-  tabled_typeclass_resolution_body (synth _ _ _ (some Answer)) _ _ Answer.
+pred tabled_typeclass_resolution_body i:synth i:assertion o:synth o:assertion.
+tabled_typeclass_resolution_body (synth _ _ _ (some Answer)) _ _ Answer.
 
-  tabled_typeclass_resolution_body
-      (synth GeneratorStack [ (pr (consumer_node Goal [ Subgoal | Remaining ]) Answer) | ResumeStack ]
-       AssertionTable RootAnswer) Query MySynth FinalAnswer :-
-    Answer = assertion AnswerT AnswerV,
-    coq.typecheck AnswerV AnswerNT ok,
-    NewAnswer = assertion AnswerNT AnswerV,
-    if (try_answer Subgoal NewAnswer Goal UpdatedGoal Remaining UpdatedRemaining)
+tabled_typeclass_resolution_body
+    (synth GeneratorStack [ (pr (consumer_node Goal [ Subgoal | Remaining ]) Answer) | ResumeStack ]
+     AssertionTable RootAnswer) Query MySynth FinalAnswer :-
+  Answer = assertion AnswerT AnswerV,
+  coq.typecheck AnswerV AnswerNT ok,
+  NewAnswer = assertion AnswerNT AnswerV,
+  if (try_answer Subgoal NewAnswer Goal UpdatedGoal Remaining UpdatedRemaining)
        (
-        /* TODO: Update Remaining with unification from try_answer ! */
-        new_consumer_node
-         (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-         UpdatedGoal /* TODO: final answer here! */
-         (consumer_node UpdatedGoal UpdatedRemaining) /* TODO: Was Goal in code, but should add new solution? */
-         MySynth
+      /* TODO: Update Remaining with unification from try_answer ! */
+      new_consumer_node
+       (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+       UpdatedGoal /* TODO: final answer here! */
+       (consumer_node UpdatedGoal UpdatedRemaining) /* TODO: Was Goal in code, but should add new solution? */
+       MySynth
       )
       (
-        MySynth = (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+      MySynth = (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
       ).
 
-  tabled_typeclass_resolution_body
-    (synth GeneratorStack [ (pr (consumer_node Goal []) Answer) | ResumeStack ]
-       AssertionTable RootAnswer) Query MySynth FinalAnswer :-
-   coq.warn "Cannot resume with empty subgoals!",
-   fail.
-
-  tabled_typeclass_resolution_body
-    (synth [ generator_node Goal [Instance | Instances ] | GeneratorStack ]
-      ResumeStack AssertionTable RootAnswer) Query NewSynth FinalAnswer :-
-    coq.say "Try",
-    if (try_resolve Goal Instance Resolved Subgoals)
+tabled_typeclass_resolution_body
+  (synth GeneratorStack [ (pr (consumer_node Goal []) Answer) | ResumeStack ]
+     AssertionTable RootAnswer) Query MySynth FinalAnswer :-
+ coq.warn "Cannot resume with empty subgoals!",
+ fail.
+
+tabled_typeclass_resolution_body
+  (synth [ generator_node Goal [Instance | Instances ] | GeneratorStack ]
+    ResumeStack AssertionTable RootAnswer) Query NewSynth FinalAnswer :-
+  coq.say "Try",
+  if (try_resolve Goal Instance Resolved Subgoals)
        (
-         coq.say "YES",
-         /* else (l. 14) */
-         new_consumer_node
-          (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
-          Resolved
-          (consumer_node Resolved Subgoals) NewSynth
+       coq.say "YES",
+       /* else (l. 14) */
+       new_consumer_node
+        (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
+        Resolved
+        (consumer_node Resolved Subgoals) NewSynth
        )
        (
-         coq.say "NO",
-         /* If first subgoal of cnode does not resolve with solution then Continue */
-         NewSynth = (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
+       coq.say "NO",
+       /* If first subgoal of cnode does not resolve with solution then Continue */
+       NewSynth = (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
        ).
 
-  tabled_typeclass_resolution_body
-    (synth [ generator_node _ [] | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
-      Query
-      (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-      FinalAnswer.
-  /* If cnode has no remaining subgoals then (ll.7-13) .. */
-
-  tabled_typeclass_resolution_body (synth [] [] _ _) _ _ _ :- fail.
-
-  pred synth_loop i:synth i:assertion i:int o:assertion.
-  synth_loop (synth _ _ _ (some Answer)) _ Fuel Answer.
-  synth_loop MySynth Query Fuel FinalAnswer :-
-    MySynth = synth Stack1 Stack2 _ _,
-    coq.say "synth round" Fuel,
-    ((Stack1 = [ generator_node (assertion (StkHd1T) (StkHd1V)) L1 | _ ] , coq.say "topG:" {coq.term->string StkHd1T} {coq.term->string StkHd1V} L1); true),
-    ((Stack2 = [ pr (consumer_node (assertion StkHd2T StkHd2V) _) (assertion AnsT AnsV) | _ ] , coq.say "topR:" {coq.term->string StkHd2T} {coq.term->string StkHd2V}, coq.say "answer:" {coq.term->string AnsT} {coq.term->string AnsV}); true),
-    coq.say "",
-    /* coq.say "synth round" Fuel Stack2 Stack1, */
-    Fuel > 0,
-    tabled_typeclass_resolution_body MySynth Query NextSynth FinalAnswer,
+tabled_typeclass_resolution_body
+  (synth [ generator_node _ [] | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
+    Query
+    (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+    FinalAnswer.
+/* If cnode has no remaining subgoals then (ll.7-13) .. */
+
+tabled_typeclass_resolution_body (synth [] [] _ _) _ _ _ :- fail.
+
+pred synth_loop i:synth i:assertion i:int o:assertion.
+synth_loop (synth _ _ _ (some Answer)) _ Fuel Answer.
+synth_loop MySynth Query Fuel FinalAnswer :-
+  MySynth = synth Stack1 Stack2 _ _,
+  coq.say "synth round" Fuel,
+  ((Stack1 = [ generator_node (assertion (StkHd1T) (StkHd1V)) L1 | _ ] , coq.say "topG:" {coq.term->string StkHd1T} {coq.term->string StkHd1V} L1); true),
+  ((Stack2 = [ pr (consumer_node (assertion StkHd2T StkHd2V) _) (assertion AnsT AnsV) | _ ] , coq.say "topR:" {coq.term->string StkHd2T} {coq.term->string StkHd2V}, coq.say "answer:" {coq.term->string AnsT} {coq.term->string AnsV}); true),
+  coq.say "",
+  /* coq.say "synth round" Fuel Stack2 Stack1, */
+  Fuel > 0,
+  tabled_typeclass_resolution_body MySynth Query NextSynth FinalAnswer,
     !,
-    NextFuel is Fuel - 1,
-    coq.say "Copy synth?",
-    synth_loop NextSynth Query NextFuel FinalAnswer.
-
-  pred tabled_typeclass_resolution i:assertion o:assertion.
-  tabled_typeclass_resolution Query FinalAnswer :-
-    std.map2.make assertion_equal AssertionTableEmpty,
-    new_subgoal (synth [] [] AssertionTableEmpty none) Query root MySynth,
-    /* while true do */
-    synth_loop MySynth Query 20000 FinalAnswer,
+  NextFuel is Fuel - 1,
+  coq.say "Copy synth?",
+  synth_loop NextSynth Query NextFuel FinalAnswer.
+
+pred tabled_typeclass_resolution i:assertion o:assertion.
+tabled_typeclass_resolution Query FinalAnswer :-
+  mymap_make assertion_equal AssertionTableEmpty,
+  new_subgoal (synth [] [] AssertionTableEmpty none) Query root MySynth,
+  /* while true do */
+  synth_loop MySynth Query 20000 FinalAnswer,
     !.
 
-  pred proof_search i:list gref i:list tc-instance i:term o:term.
-  proof_search Typeclasses [tc-instance Hd _ | _ ] Type PRoof :-
-    coq.env.typeof Hd TypeRes,
-    coq.env.global Hd ProofRes,
-    coq.say "CHECKING" TypeRes,
-    coq.unify-eq TypeRes Type D,
-    coq.say D,
-    D = ok,
-    % TypeRes = Type,
-    coq.say "SUCCESS",
-    PRoof = ProofRes.
-  proof_search Typeclasses [_|Tl] Type PRoof :-
-    proof_search Typeclasses Tl Type PRoof.
-
-  pred tabled_proof_search i:list gref i:term o:term.
-  tabled_proof_search Typeclasses Type PRoof :-
-    coq.say "TYPECLASSES" Typeclasses,
-    MyGoal = assertion Type {{ _ }},
-    tabled_typeclass_resolution MyGoal FinalAnswer,
+pred proof_search i:list gref i:list tc-instance i:term o:term.
+proof_search Typeclasses [tc-instance Hd _ | _ ] Type PRoof :-
+  coq.env.typeof Hd TypeRes,
+  coq.env.global Hd ProofRes,
+  coq.say "CHECKING" TypeRes,
+  coq.unify-eq TypeRes Type D,
+  coq.say D,
+  D = ok,
+  % TypeRes = Type,
+  coq.say "SUCCESS",
+  PRoof = ProofRes.
+proof_search Typeclasses [_|Tl] Type PRoof :-
+  proof_search Typeclasses Tl Type PRoof.
+
+pred tabled_proof_search i:list gref i:term o:term.
+tabled_proof_search Typeclasses Type PRoof :-
+  coq.say "TYPECLASSES" Typeclasses,
+  MyGoal = assertion Type {{ _ }},
+  tabled_typeclass_resolution MyGoal FinalAnswer,
     !,
 
-    /* Convert from result to proof term! */
+  /* Convert from result to proof term! */
 
-    FinalAnswer = assertion FinalType FinalTerm,
-    FinalProof = FinalTerm,
-    coq.say "FinalProof" {coq.term->string FinalProof},
-    PRoof = FinalProof,
-    coq.say "Proof" {coq.term->string PRoof} "Done"
+  FinalAnswer = assertion FinalType FinalTerm,
+  FinalProof = FinalTerm,
+  coq.say "FinalProof" {coq.term->string FinalProof},
+  PRoof = FinalProof,
+  coq.say "Proof" {coq.term->string PRoof} "Done"
     .
 
 
-  pred search_context i:list prop i:term o:term.
-  search_context [decl Te N Ty | _] Type PRoof :-
-    Ty = Type,
-    Te = PRoof,
-    coq.say "CHECK SUCC" N PRoof.
-  search_context [_|Tl] Type PRoof :- search_context Tl Type PRoof.
+pred search_context i:list prop i:term o:term.
+search_context [decl Te N Ty | _] Type PRoof :-
+  Ty = Type,
+  Te = PRoof,
+  coq.say "CHECK SUCC" N PRoof.
+search_context [_|Tl] Type PRoof :- search_context Tl Type PRoof.
 
-  solve (goal Ctx Trigger Type PRoof Args as G) V :-
-    coq.TC.db-tc Typeclasses,
-    coq.say "AGRS" Args Ctx,
-    coq.say "SEARCHING ..." {coq.term->string Type}, !,
-    coq.say "V" V,
-    (search_context Ctx Type PRoof ; tabled_proof_search Typeclasses Type PRoof),
-    coq.say "SUCCESS FINDING INSTANCE".
+solve (goal Ctx Trigger Type PRoof Args as G) V :-
+  coq.TC.db-tc Typeclasses,
+  coq.say "AGRS" Args Ctx,
+  coq.say "SEARCHING ..." {coq.term->string Type}, !,
+  coq.say "V" V,
+  (search_context Ctx Type PRoof ; tabled_proof_search Typeclasses Type PRoof),
+  coq.say "SUCCESS FINDING INSTANCE".
 
 
-  solve _ _ :- coq.ltac.fail _ "No auto".
+solve _ _ :- coq.ltac.fail _ "No auto".
diff --git a/apps/tc-tabled/elpi/test.elpi b/apps/tc-tabled/elpi/test.elpi
deleted file mode 100644
index 8b1378917..000000000
--- a/apps/tc-tabled/elpi/test.elpi
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/apps/tc-tabled/theories/diamond.v b/apps/tc-tabled/theories/diamond.v
index 83779ebfb..e92411e8e 100644
--- a/apps/tc-tabled/theories/diamond.v
+++ b/apps/tc-tabled/theories/diamond.v
@@ -80,8 +80,8 @@ Elpi TC Solver Override TC.TabledSolver All.
 
 Module Test20Tabled. Time Instance TtR20 : B unit 20 := _. End Test20Tabled.
 
-(* Finished transaction in 55.794 secs (55.684u,0.097s) (successful) *)
-Module Test100Tabled. Time Instance TtR100 : B unit 100 := _. End Test100Tabled.
+(* (* Finished transaction in 55.794 secs (55.684u,0.097s) (successful) *) *)
+(* Module Test100Tabled. Time Instance TtR100 : B unit 100 := _. End Test100Tabled. *)
 
 (* (* Finished transaction in 737.925 secs (736.366u,0.837s) (successful) *) *)
 (* Module Test200Tabled. Time Instance TtR200 : B unit 200 := _. End Test200Tabled. *)

From 5535978121aa016c543a154b8c1be1d6fc0373c5 Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Tue, 12 Aug 2025 23:22:03 +0200
Subject: [PATCH 17/23] Cleaup

---
 apps/tc-tabled/elpi/custom_map.elpi         |  65 ++++
 apps/tc-tabled/elpi/map2.elpi               | 141 +++++++
 apps/tc-tabled/elpi/tabled_type_class.elpi  | 404 ++++----------------
 apps/tc-tabled/theories/tabled_type_class.v |  27 ++
 4 files changed, 305 insertions(+), 332 deletions(-)
 create mode 100644 apps/tc-tabled/elpi/custom_map.elpi
 create mode 100644 apps/tc-tabled/elpi/map2.elpi

diff --git a/apps/tc-tabled/elpi/custom_map.elpi b/apps/tc-tabled/elpi/custom_map.elpi
new file mode 100644
index 000000000..0cc1aeafa
--- /dev/null
+++ b/apps/tc-tabled/elpi/custom_map.elpi
@@ -0,0 +1,65 @@
+pred binary_search i:K i:(pred i:K i:K o:cmp) i:int i:int i:list K o:int o:bool.
+binary_search A Cmp L R XS Out Approx :-
+  if (le_ L R)
+   	(M is L + ((R - L) div 2),
+   	std.nth M XS X,
+   	Cmp X A C,
+    !,
+   	if (C = lt)
+ 	     (!, binary_search A Cmp (M + 1) R XS Out Approx)
+ 	     (if (C = gt)
+ 	         (!, binary_search A Cmp L (M - 1) XS Out Approx)
+ 	         (!, Out is M, Approx = ff)))
+ 	  (Out is L, Approx = tt)
+    , !.
+
+kind custom_map type -> type -> type.
+type custom_map list (pair K V) -> (pred i:K i:K o:cmp) -> custom_map K V.
+
+pred custom_make i:(pred i:K, i:K, o:cmp), o:custom_map K V.
+custom_make Cmp (custom_map [] Cmp).
+
+pred cmp_fst_pair i:(pred i:K i:K o:cmp) i:pair K V i:pair K V o:cmp.
+cmp_fst_pair Cmp (pr K1 _) (pr K2 _) C :- Cmp K1 K2 C.
+
+pred custom_find i:K, i:custom_map K V, o:V.
+custom_find K (custom_map M Cmp) V :-
+  std.length M Len,
+  binary_search (pr K (_ /* dummy value */)) (cmp_fst_pair Cmp) 0 (Len - 1) M I ff,
+  !,
+  std.nth I M (pr KK V),
+  Cmp KK K eq,
+  !.
+
+pred insert_index i:int i:V i:list V o:list V.
+%% insert_index I V L O :- /* std.append F [ (pr K VI) | T  ] M1 */
+%%   std.split-at I L F T,
+%%   !,
+%%   std.append F [ V | T ] O.
+insert_index 0 V L [ V | L ].
+insert_index N V [ X | L ] [ X | O ] :-
+  NN is N - 1,
+  insert_index NN V L O.
+
+pred update_index i:int i:V i:list V o:list V.
+%% update_index I V L O :- /* T = [ pr KK _ | VS ] , Cmp KK K eq , std.append F [ (pr K VI) | VS ] M1 */
+%%   std.split-at I L F [ _ | T ],
+%%   !,
+%%   std.append F [ V | T ] O.
+update_index 0 V [ _ | L ] [ V | L ] :- !.
+update_index N V [ X | L ] [ X | O ] :-
+  NN is N - 1,
+  !,
+  update_index NN V L O,
+  !.
+
+pred custom_add i:K, i:V, i:custom_map K V, o:custom_map K V.
+custom_add K V (custom_map M Cmp) (custom_map M1 Cmp) :-
+  std.length M Len,
+  coq.say "Search",
+  binary_search (pr K (_ /* dummy value */)) (cmp_fst_pair Cmp) 0 (Len - 1) M I Approx,
+  if (Approx = tt)
+  (coq.say "Insert", insert_index I (pr K V) M M1) /* insert */
+  (coq.say "Update", update_index I (pr K V) M M1 ) /* update */
+  , coq.say "Done"
+  , !.
diff --git a/apps/tc-tabled/elpi/map2.elpi b/apps/tc-tabled/elpi/map2.elpi
new file mode 100644
index 000000000..29f180366
--- /dev/null
+++ b/apps/tc-tabled/elpi/map2.elpi
@@ -0,0 +1,141 @@
+kind std.map2 type -> type -> type.
+type std.map2 std.map2.private.map K V -> (pred i:K, i:K, o:cmp) -> std.map2 K V.
+
+namespace std.map2 {
+
+  % [make Eq Ltn M] builds an empty map M where keys are compared using Eq and Ltn
+  pred make i:(pred i:K, i:K, o:cmp), o:std.map2 K V.
+  make Cmp (std.map2 private.empty Cmp).
+
+  % [find K M V] looks in M for the value V associated to K
+  pred find i:K, i:std.map2 K V, o:V.
+  find K (std.map2 M Cmp) V :-
+    coq.say "Find",
+    private.find M Cmp K V,
+    coq.say "FY".
+  find _ _ _ :- coq.say "FN", fail.
+
+  % [add K V M M1] M1 is M where K is bound to V
+  pred add i:K, i:V, i:std.map2 K V, o:std.map2 K V.
+  add K V (std.map2 M Cmp) (std.map2 M1 Cmp) :-
+    private.add M Cmp K V M1.
+
+  % [update K V M M1] M1 is M where K is bound to V
+  pred update i:K, i:V, i:std.map2 K V, o:std.map2 K V.
+  update K V (std.map2 M Cmp) (std.map2 M1 Cmp) :-
+    private.update M Cmp K V M1.
+
+  % [remove K M M1] M1 is M where K is unbound
+  pred remove i:K, i:std.map2 K V, o:std.map2 K V.
+  remove K (std.map2 M Cmp) (std.map2 M1 Cmp) :- private.remove M Cmp K M1.
+
+  % [bindings M L] L is the key-value pairs in increasing order
+  pred bindings i:std.map2 K V, o:list (pair K V).
+  bindings (std.map2 M _) L :- private.bindings M [] L.
+
+  namespace private {
+
+    % Taken from OCaml's map.ml
+    kind map type -> type -> type.
+    type empty map K V.
+    type node map K V -> K -> V -> map K V -> int -> map K V.
+
+    pred height i:map K V, o:int.
+    height empty 0.
+    height (node _ _ _ _ H) H.
+
+    pred create i:map K V, i:K, i:V, i:map K V, o:map K V.
+    create L K V R (node L K V R H) :- H is {std.max {height L} {height R} } + 1.
+
+    pred print_m i:(map K V) o:string.
+    print_m (empty) "emtpy".
+    print_m (node L _ _ R I) S :-
+      print_m L SL,
+      print_m R SR,
+      S is "(" ^ SL ^ "," ^ "," ^ SR ^ ")"
+      .
+
+    pred bal i:map K V, i:K, i:V, i:map K V, o:map K V.
+    bal L K V R T :-
+      height L HL,
+      height R HR,
+      HL2 is HL + 2,
+      HR2 is HR + 2,
+      bal.aux HL HR HL2 HR2 L K V R T.
+
+    pred bal.aux i:int, i:int, i:int, i:int, i:map K V, i:K, i:V, i:map K V, o:map K V.
+    bal.aux HL _ _ HR2 (node LL LV LD LR _) X D R T :-
+      HL > HR2, {height LL} >= {height LR}, !,
+      create LL LV LD {create LR X D R} T.
+    bal.aux HL _ _ HR2 (node LL LV LD (node LRL LRV LRD LRR _) _) X D R T :-
+      HL > HR2, !,
+      create {create LL LV LD LRL} LRV LRD {create LRR X D R} T.
+    bal.aux _ HR HL2 _ L X D (node RL RV RD RR _) T :-
+      HR > HL2, {height RR} >= {height RL}, !,
+      create {create L X D RL} RV RD RR T.
+    bal.aux _ HR HL2 _ L X D (node (node RLL RLV RLD RLR _) RV RD RR _) T :-
+      HR > HL2, !,
+      create {create L X D RLL} RLV RLD {create RLR RV RD RR} T.
+    bal.aux _ _ _ _ L K V R T :- create L K V R T.
+
+    pred add i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
+    add empty _ K V T :- create empty K V empty T.
+    add (node _ X _ _ _ as M) Cmp X1 XD M1 :- Cmp X1 X E, !, add.aux E M Cmp X1 XD M1.
+
+    pred add.aux i:cmp, i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
+    add.aux eq (node L _ _ R H) _   X XD T :- T = node L X XD R H, !.
+    add.aux lt (node L V D R _) Cmp X XD T :- bal {add L Cmp X XD} V D R T, !.
+    add.aux gt (node L V D R _) Cmp X XD T :- bal L V D {add R Cmp X XD} T, !.
+
+    pred update i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
+    update (node _ X _ _ _ as M) Cmp X1 XD M1 :-
+      !, Cmp X1 X E, !, update.aux E M Cmp X1 XD M1, !.
+
+    pred update.aux i:cmp, i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
+    update.aux eq (node L _ _ R H) _   X XD T :-
+      T = node L X XD R H, !.
+    update.aux lt (node L V D R H) Cmp X XD T :-
+      T = node {update L Cmp X XD} V D R H, !.
+    update.aux gt (node L V D R H) Cmp X XD T :-
+      T = node L V D {update R Cmp X XD} H, !.
+
+    pred find i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:V.
+    find ((node L K1 V1 R _) as M) Cmp K V :-
+      Cmp K K1 E, find.aux E Cmp L R V1 K V.
+
+    pred find.aux i:cmp, i:(pred i:K, i:K, o:cmp), i:map K V, i:map K V, i:V, i:K, o:V.
+    find.aux eq _   _ _ V _ V.
+    find.aux lt Cmp L _ _ K V :- find L Cmp K V.
+    find.aux gt Cmp _ R _ K V :- find R Cmp K V.
+
+    pred remove-min-binding i:map K V, o:map K V.
+    remove-min-binding (node empty _ _ R _) R :- !.
+    remove-min-binding (node L V D R _) X :- bal {remove-min-binding L} V D R X.
+
+    pred min-binding i:map K V, o:K, o:V.
+    min-binding (node empty V D _ _) V D :- !.
+    min-binding (node L _ _ _ _) V D :- min-binding L V D.
+
+    pred merge i:map K V, i:map K V, o:map K V.
+    merge empty X X :- !.
+    merge X empty X :- !.
+    merge M1 M2 R :-
+      min-binding M2 X D,
+      bal M1 X D {remove-min-binding M2} R.
+
+    pred remove i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:map K V.
+    remove empty _ _ empty :- !.
+    remove (node L V D R _) Cmp X M :- Cmp X V E, remove.aux E Cmp L R V D X M.
+
+    pred remove.aux i:cmp, i:(pred i:K, i:K, o:cmp), i:map K V, i:map K V, i:K, i:V, i:K, o:map K V.
+    remove.aux eq _   L R _ _ _ M :- merge L R M.
+    remove.aux lt Cmp L R V D X M :- bal {remove L Cmp X} V D R M.
+    remove.aux gt Cmp L R V D X M :- bal L V D {remove R Cmp X} M.
+
+    pred bindings i:map K V, i:list (pair K V), o:list (pair K V).
+    bindings empty X X.
+    bindings (node L V D R _) X X1 :-
+      bindings L [pr V D|{bindings R X}] X1.
+
+  } % std.map2.private
+} % std.map2
diff --git a/apps/tc-tabled/elpi/tabled_type_class.elpi b/apps/tc-tabled/elpi/tabled_type_class.elpi
index 2bcfbc486..7db4fdf13 100644
--- a/apps/tc-tabled/elpi/tabled_type_class.elpi
+++ b/apps/tc-tabled/elpi/tabled_type_class.elpi
@@ -1,231 +1,3 @@
-pred binary_search i:K i:(pred i:K i:K o:cmp) i:int i:int i:list K o:int o:bool.
-binary_search A Cmp L R XS Out Approx :-
-  if (le_ L R)
-   	(M is L + ((R - L) div 2),
-   	std.nth M XS X,
-   	Cmp X A C,
-    !,
-   	if (C = lt)
- 	     (!, binary_search A Cmp (M + 1) R XS Out Approx)
- 	     (if (C = gt)
- 	         (!, binary_search A Cmp L (M - 1) XS Out Approx)
- 	         (!, Out is M, Approx = ff)))
- 	  (Out is L, Approx = tt)
-    , !.
-
-kind std.map2 type -> type -> type.
-type std.map2 std.map2.private.map K V -> (pred i:K, i:K, o:cmp) -> std.map2 K V.
-
-namespace std.map2 {
-
-% [make Eq Ltn M] builds an empty map M where keys are compared using Eq and Ltn
-pred make i:(pred i:K, i:K, o:cmp), o:std.map2 K V.
-make Cmp (std.map2 private.empty Cmp).
-
-% [find K M V] looks in M for the value V associated to K
-pred find i:K, i:std.map2 K V, o:V.
-find K (std.map2 M Cmp) V :-
-  coq.say "Find",
-  private.find M Cmp K V,
-  coq.say "FY".
-find _ _ _ :- coq.say "FN", fail.
-
-% [add K V M M1] M1 is M where K is bound to V
-pred add i:K, i:V, i:std.map2 K V, o:std.map2 K V.
-add K V (std.map2 M Cmp) (std.map2 M1 Cmp) :-
-  private.add M Cmp K V M1.
-
-% [update K V M M1] M1 is M where K is bound to V
-pred update i:K, i:V, i:std.map2 K V, o:std.map2 K V.
-update K V (std.map2 M Cmp) (std.map2 M1 Cmp) :-
-  private.update M Cmp K V M1.
-
-% [remove K M M1] M1 is M where K is unbound
-pred remove i:K, i:std.map2 K V, o:std.map2 K V.
-remove K (std.map2 M Cmp) (std.map2 M1 Cmp) :- private.remove M Cmp K M1.
-
-% [bindings M L] L is the key-value pairs in increasing order
-pred bindings i:std.map2 K V, o:list (pair K V).
-bindings (std.map2 M _) L :- private.bindings M [] L.
-
-namespace private {
-
-% Taken from OCaml's map.ml
-kind map type -> type -> type.
-type empty map K V.
-type node map K V -> K -> V -> map K V -> int -> map K V.
-
-pred height i:map K V, o:int.
-height empty 0.
-height (node _ _ _ _ H) H.
-
-pred create i:map K V, i:K, i:V, i:map K V, o:map K V.
-create L K V R (node L K V R H) :- H is {std.max {height L} {height R} } + 1.
-
-pred print_m i:(map K V) o:string.
-print_m (empty) "emtpy".
-print_m (node L _ _ R I) S :-
-  print_m L SL,
-  print_m R SR,
-  S is "(" ^ SL ^ "," ^ "," ^ SR ^ ")"
-  .
-
-pred bal i:map K V, i:K, i:V, i:map K V, o:map K V.
-bal L K V R T :-
-  height L HL,
-  height R HR,
-  HL2 is HL + 2,
-  HR2 is HR + 2,
-  bal.aux HL HR HL2 HR2 L K V R T.
-
-pred bal.aux i:int, i:int, i:int, i:int, i:map K V, i:K, i:V, i:map K V, o:map K V.
-bal.aux HL _ _ HR2 (node LL LV LD LR _) X D R T :-
-  HL > HR2, {height LL} >= {height LR}, !,
-  create LL LV LD {create LR X D R} T.
-bal.aux HL _ _ HR2 (node LL LV LD (node LRL LRV LRD LRR _) _) X D R T :-
-  HL > HR2, !,
-  create {create LL LV LD LRL} LRV LRD {create LRR X D R} T.
-bal.aux _ HR HL2 _ L X D (node RL RV RD RR _) T :-
-  HR > HL2, {height RR} >= {height RL}, !,
-  create {create L X D RL} RV RD RR T.
-bal.aux _ HR HL2 _ L X D (node (node RLL RLV RLD RLR _) RV RD RR _) T :-
-  HR > HL2, !,
-  create {create L X D RLL} RLV RLD {create RLR RV RD RR} T.
-bal.aux _ _ _ _ L K V R T :- create L K V R T.
-
-pred add i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
-add empty _ K V T :- create empty K V empty T.
-add (node _ X _ _ _ as M) Cmp X1 XD M1 :- Cmp X1 X E, !, add.aux E M Cmp X1 XD M1.
-
-pred add.aux i:cmp, i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
-add.aux eq (node L _ _ R H) _   X XD T :- T = node L X XD R H, !.
-add.aux lt (node L V D R _) Cmp X XD T :- bal {add L Cmp X XD} V D R T, !.
-add.aux gt (node L V D R _) Cmp X XD T :- bal L V D {add R Cmp X XD} T, !.
-
-pred update i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
-update (node _ X _ _ _ as M) Cmp X1 XD M1 :-
-  !, Cmp X1 X E, !, update.aux E M Cmp X1 XD M1, !.
-
-pred update.aux i:cmp, i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
-update.aux eq (node L _ _ R H) _   X XD T :-
-  T = node L X XD R H, !.
-update.aux lt (node L V D R H) Cmp X XD T :-
-  T = node {update L Cmp X XD} V D R H, !.
-update.aux gt (node L V D R H) Cmp X XD T :-
-  T = node L V D {update R Cmp X XD} H, !.
-
-pred find i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:V.
-find ((node L K1 V1 R _) as M) Cmp K V :-
-  Cmp K K1 E, find.aux E Cmp L R V1 K V.
-
-pred find.aux i:cmp, i:(pred i:K, i:K, o:cmp), i:map K V, i:map K V, i:V, i:K, o:V.
-find.aux eq _   _ _ V _ V.
-find.aux lt Cmp L _ _ K V :- find L Cmp K V.
-find.aux gt Cmp _ R _ K V :- find R Cmp K V.
-
-pred remove-min-binding i:map K V, o:map K V.
-remove-min-binding (node empty _ _ R _) R :- !.
-remove-min-binding (node L V D R _) X :- bal {remove-min-binding L} V D R X.
-
-pred min-binding i:map K V, o:K, o:V.
-min-binding (node empty V D _ _) V D :- !.
-min-binding (node L _ _ _ _) V D :- min-binding L V D.
-
-pred merge i:map K V, i:map K V, o:map K V.
-merge empty X X :- !.
-merge X empty X :- !.
-merge M1 M2 R :-
-  min-binding M2 X D,
-  bal M1 X D {remove-min-binding M2} R.
-
-pred remove i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:map K V.
-remove empty _ _ empty :- !.
-remove (node L V D R _) Cmp X M :- Cmp X V E, remove.aux E Cmp L R V D X M.
-
-pred remove.aux i:cmp, i:(pred i:K, i:K, o:cmp), i:map K V, i:map K V, i:K, i:V, i:K, o:map K V.
-remove.aux eq _   L R _ _ _ M :- merge L R M.
-remove.aux lt Cmp L R V D X M :- bal {remove L Cmp X} V D R M.
-remove.aux gt Cmp L R V D X M :- bal L V D {remove R Cmp X} M.
-
-pred bindings i:map K V, i:list (pair K V), o:list (pair K V).
-bindings empty X X.
-bindings (node L V D R _) X X1 :-
-  bindings L [pr V D|{bindings R X}] X1.
-
-
-} % std.map2.private
-} % std.map2
-
-kind custom_map type -> type -> type.
-type custom_map list (pair K V) -> (pred i:K i:K o:cmp) -> custom_map K V.
-
-pred custom_make i:(pred i:K, i:K, o:cmp), o:custom_map K V.
-custom_make Cmp (custom_map [] Cmp).
-
-pred cmp_fst_pair i:(pred i:K i:K o:cmp) i:pair K V i:pair K V o:cmp.
-cmp_fst_pair Cmp (pr K1 _) (pr K2 _) C :- Cmp K1 K2 C.
-
-pred custom_find i:K, i:custom_map K V, o:V.
-custom_find K (custom_map M Cmp) V :-
-  std.length M Len,
-  binary_search (pr K (_ /* dummy value */)) (cmp_fst_pair Cmp) 0 (Len - 1) M I ff,
-  !,
-  std.nth I M (pr KK V),
-  Cmp KK K eq,
-  !.
-
-pred insert_index i:int i:V i:list V o:list V.
-%% insert_index I V L O :- /* std.append F [ (pr K VI) | T  ] M1 */
-%%   std.split-at I L F T,
-%%   !,
-%%   std.append F [ V | T ] O.
-insert_index 0 V L [ V | L ].
-insert_index N V [ X | L ] [ X | O ] :-
-  NN is N - 1,
-  insert_index NN V L O.
-
-pred update_index i:int i:V i:list V o:list V.
-%% update_index I V L O :- /* T = [ pr KK _ | VS ] , Cmp KK K eq , std.append F [ (pr K VI) | VS ] M1 */
-%%   std.split-at I L F [ _ | T ],
-%%   !,
-%%   std.append F [ V | T ] O.
-update_index 0 V [ _ | L ] [ V | L ] :- !.
-update_index N V [ X | L ] [ X | O ] :-
-  NN is N - 1,
-  !,
-  update_index NN V L O,
-  !.
-
-pred custom_add i:K, i:V, i:custom_map K V, o:custom_map K V.
-custom_add K V (custom_map M Cmp) (custom_map M1 Cmp) :-
-  std.length M Len,
-  coq.say "Search",
-  binary_search (pr K (_ /* dummy value */)) (cmp_fst_pair Cmp) 0 (Len - 1) M I Approx,
-  if (Approx = tt)
-  (coq.say "Insert", insert_index I (pr K V) M M1) /* insert */
-  (coq.say "Update", update_index I (pr K V) M M1 ) /* update */
-  , coq.say "Done"
-  , !.
-
-pred mymap_make i:(pred i:K, i:K, o:cmp), o:mymap K V.
-pred mymap_find i:K i:(mymap K V) o:V.
-pred mymap_add i:K i:V i:(mymap K V) o:(mymap K V).
-pred mymap_update i:K i:V i:(mymap K V) o:(mymap K V).
-
-%% typeabbrev (mymap K V) (custom_map K V).
-
-%% mymap_make Cmp M :- custom_make Cmp M.
-%% mymap_find K M V :- custom_find K M V.
-%% mymap_add K V M M1 :- custom_add K V M M1.
-%% mymap_update K V M M1 :- custom_add K V M M1.
-
-typeabbrev (mymap K V) (std.map2 K V).
-
-mymap_make Cmp M :- std.map2.make Cmp M.
-mymap_find K M V :- std.map2.find K M V.
-mymap_add K V M M1 :- std.map2.add K V M M1.
-mymap_update K V M M1 :- std.map2.update K V M M1.
-
 /*
 (* https://github.com/leanprover/lean4/blob/cade21/src/Lean/Meta/SynthInstance.lean *)
 (* https://github.com/LPCIC/coq-elpi/blob/master/builtin-doc/coq-builtin.elpi *)
@@ -290,10 +62,8 @@ type_equal_list [ X | _ ] [ Y | _ ] Cmp :-
     not (Cmp = eq).
 type_equal_list [] [] eq.
 
-
 pred assertion_equal i:assertion i:assertion o:cmp.
 assertion_equal (assertion A _) (assertion B _) Cmp :-
-/* coq.say {coq.term->string A} "VS" {coq.term->string B}, */
   type_equal A B Cmp,
   !
   /* Deterministic ! */
@@ -484,106 +254,97 @@ try_resolve (assertion A _) (tc-instance BI _) (assertion RT RV) RL :-
 pred temp_fun i:consumer_node i:assertion o:(pair consumer_node assertion).
 temp_fun A B (pr A B).
 
-pred waiter_fun i:assertion i:assertion i:waiter i:(pair (resume_stack) (option assertion)) o:(pair (resume_stack) (option assertion)).
-waiter_fun Answer Guess root (pr A _) (pr A (some Answer)).
-waiter_fun Answer Goal (callback C) (pr A R) (pr [pr C Answer /* Goal */ | A] R).
+pred waiter_fun i:assertion i:waiter i:(pair (resume_stack) (option assertion)) o:(pair (resume_stack) (option assertion)).
+waiter_fun Answer root (pr A _) (pr A (some Answer)).
+waiter_fun Answer (callback C) (pr A R) (pr [pr C Answer /* Goal */ | A] R).
 
-pred new_consumer_node i:synth i:assertion i:consumer_node o:synth.
+pred new_consumer_node i:synth i:consumer_node o:synth.
 new_consumer_node
     (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-    Answer
     (consumer_node Goal [])
     (synth GeneratorStack NewResumeStack NewAssertionTable NewRootAnswer) :-
   /* for each solution to g, push new cnode onto resume stack with it */
   mymap_find Goal AssertionTable (entry Waiters Answers),
   /* for each solution to g, push new cnode onto resume stack with it */
-  std.fold Waiters (pr ResumeStack RootAnswer) (waiter_fun Answer Goal) (pr NewResumeStack NewRootAnswer),
+  std.fold Waiters (pr ResumeStack RootAnswer) (waiter_fun Goal) (pr NewResumeStack NewRootAnswer),
   /* add new cnode to g's dependents */
-  coq.say "Update",
-  mymap_update Goal (entry Waiters [ Answer | Answers ]) AssertionTable NewAssertionTable,
-  coq.say "Done",
-    !.
+  mymap_update Goal (entry Waiters [ Goal | Answers ]) AssertionTable NewAssertionTable,
+  !.
 
 new_consumer_node
     (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-      _
     (consumer_node _ [ Subgoal | _ ] as CN)
     (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer) :-
-    /* TODO: Consumer node is general instead of variable or hole */
-    if (mymap_find Subgoal AssertionTable (entry Waiters Answers))
-         (
-        /* Map answers with consumer node */
-        /* Add cnode onto G's dependents? */
-        std.map Answers (temp_fun CN) TempResumeStack,
-        std.append TempResumeStack ResumeStack NewResumeStack,
-
-        NewWaiters = [ callback CN | Waiters ],
-        mymap_update Subgoal (entry NewWaiters Answers) AssertionTable NewAssertionTable,
-        NewGeneratorStack = GeneratorStack
-         )
-         (
-        new_subgoal
-          (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-          Subgoal
-          (callback CN)
-          (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer)
-        ),
-        !.
-
-  new_consumer_node _ _ _ _ :- coq.error "Failed new consumer node!" , fail.
+  if (mymap_find Subgoal AssertionTable (entry Waiters Answers))
+     (
+       /* Map answers with consumer node */
+       /* Add cnode onto G's dependents? */
+       std.map Answers (temp_fun CN) TempResumeStack,
+       std.append TempResumeStack ResumeStack NewResumeStack,
+
+       NewWaiters = [ callback CN | Waiters ],
+       mymap_update Subgoal (entry NewWaiters Answers) AssertionTable NewAssertionTable,
+       NewGeneratorStack = GeneratorStack
+     )
+     (
+       new_subgoal
+         (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+         Subgoal
+         (callback CN)
+         (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer)
+     ),
+     !.
+
+new_consumer_node _ _ _ :- coq.error "Failed new consumer node!" , fail.
 
 pred tabled_typeclass_resolution_body i:synth i:assertion o:synth o:assertion.
 tabled_typeclass_resolution_body (synth _ _ _ (some Answer)) _ _ Answer.
 
-tabled_typeclass_resolution_body
-    (synth GeneratorStack [ (pr (consumer_node Goal [ Subgoal | Remaining ]) Answer) | ResumeStack ]
-     AssertionTable RootAnswer) Query MySynth FinalAnswer :-
+tabled_typeclass_resolution_body (synth GeneratorStack
+				  [ (pr (consumer_node Goal [ Subgoal | Remaining ]) Answer) | ResumeStack ]
+				  AssertionTable RootAnswer)
+    Query MySynth FinalAnswer :-
   Answer = assertion AnswerT AnswerV,
   coq.typecheck AnswerV AnswerNT ok,
   NewAnswer = assertion AnswerNT AnswerV,
   if (try_answer Subgoal NewAnswer Goal UpdatedGoal Remaining UpdatedRemaining)
-       (
-      /* TODO: Update Remaining with unification from try_answer ! */
-      new_consumer_node
-       (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-       UpdatedGoal /* TODO: final answer here! */
-       (consumer_node UpdatedGoal UpdatedRemaining) /* TODO: Was Goal in code, but should add new solution? */
-       MySynth
+     (
+       new_consumer_node
+         (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+         (consumer_node UpdatedGoal UpdatedRemaining) /* TODO: Was Goal in code, but should add new solution? */
+         MySynth
       )
       (
-      MySynth = (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+        MySynth = (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
       ).
 
-tabled_typeclass_resolution_body
-  (synth GeneratorStack [ (pr (consumer_node Goal []) Answer) | ResumeStack ]
-     AssertionTable RootAnswer) Query MySynth FinalAnswer :-
- coq.warn "Cannot resume with empty subgoals!",
- fail.
+tabled_typeclass_resolution_body (synth GeneratorStack
+				  [ (pr (consumer_node Goal []) Answer) | ResumeStack ]
+				  AssertionTable RootAnswer)
+    Query MySynth FinalAnswer :-
+  coq.warn "Cannot resume with empty subgoals!",
+  fail.
 
 tabled_typeclass_resolution_body
   (synth [ generator_node Goal [Instance | Instances ] | GeneratorStack ]
     ResumeStack AssertionTable RootAnswer) Query NewSynth FinalAnswer :-
-  coq.say "Try",
   if (try_resolve Goal Instance Resolved Subgoals)
-       (
-       coq.say "YES",
+     (
        /* else (l. 14) */
        new_consumer_node
-        (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
-        Resolved
-        (consumer_node Resolved Subgoals) NewSynth
-       )
-       (
-       coq.say "NO",
+         (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
+         (consumer_node Resolved Subgoals) NewSynth
+     )
+     (
        /* If first subgoal of cnode does not resolve with solution then Continue */
        NewSynth = (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
-       ).
+     ).
 
-tabled_typeclass_resolution_body
-  (synth [ generator_node _ [] | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
+tabled_typeclass_resolution_body (synth
+				  [ generator_node _ [] | GeneratorStack ]
+				  ResumeStack AssertionTable RootAnswer)
     Query
-    (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
-    FinalAnswer.
+    (synth GeneratorStack ResumeStack AssertionTable RootAnswer) FinalAnswer.
 /* If cnode has no remaining subgoals then (ll.7-13) .. */
 
 tabled_typeclass_resolution_body (synth [] [] _ _) _ _ _ :- fail.
@@ -591,17 +352,20 @@ tabled_typeclass_resolution_body (synth [] [] _ _) _ _ _ :- fail.
 pred synth_loop i:synth i:assertion i:int o:assertion.
 synth_loop (synth _ _ _ (some Answer)) _ Fuel Answer.
 synth_loop MySynth Query Fuel FinalAnswer :-
+  /* Print debug info */
   MySynth = synth Stack1 Stack2 _ _,
+  std.length Stack1 Stack1Len,
+  std.length Stack2 Stack2Len,
   coq.say "synth round" Fuel,
-  ((Stack1 = [ generator_node (assertion (StkHd1T) (StkHd1V)) L1 | _ ] , coq.say "topG:" {coq.term->string StkHd1T} {coq.term->string StkHd1V} L1); true),
-  ((Stack2 = [ pr (consumer_node (assertion StkHd2T StkHd2V) _) (assertion AnsT AnsV) | _ ] , coq.say "topR:" {coq.term->string StkHd2T} {coq.term->string StkHd2V}, coq.say "answer:" {coq.term->string AnsT} {coq.term->string AnsV}); true),
+  ((Stack1 = [ generator_node (assertion (StkHd1T) (StkHd1V)) L1 | _ ] , coq.say Stack1Len "topG:" {coq.term->string StkHd1T} {coq.term->string StkHd1V} L1); true),
+  ((Stack2 = [ pr (consumer_node (assertion StkHd2T StkHd2V) _) (assertion AnsT AnsV) | _ ] , coq.say Stack2Len "topR:" {coq.term->string StkHd2T} {coq.term->string StkHd2V}, coq.say "answer:" {coq.term->string AnsT} {coq.term->string AnsV}); true),
   coq.say "",
   /* coq.say "synth round" Fuel Stack2 Stack1, */
+  /* endof - Print debug info */
   Fuel > 0,
   tabled_typeclass_resolution_body MySynth Query NextSynth FinalAnswer,
-    !,
+  !,
   NextFuel is Fuel - 1,
-  coq.say "Copy synth?",
   synth_loop NextSynth Query NextFuel FinalAnswer.
 
 pred tabled_typeclass_resolution i:assertion o:assertion.
@@ -610,53 +374,29 @@ tabled_typeclass_resolution Query FinalAnswer :-
   new_subgoal (synth [] [] AssertionTableEmpty none) Query root MySynth,
   /* while true do */
   synth_loop MySynth Query 20000 FinalAnswer,
-    !.
-
-pred proof_search i:list gref i:list tc-instance i:term o:term.
-proof_search Typeclasses [tc-instance Hd _ | _ ] Type PRoof :-
-  coq.env.typeof Hd TypeRes,
-  coq.env.global Hd ProofRes,
-  coq.say "CHECKING" TypeRes,
-  coq.unify-eq TypeRes Type D,
-  coq.say D,
-  D = ok,
-  % TypeRes = Type,
-  coq.say "SUCCESS",
-  PRoof = ProofRes.
-proof_search Typeclasses [_|Tl] Type PRoof :-
-  proof_search Typeclasses Tl Type PRoof.
-
-pred tabled_proof_search i:list gref i:term o:term.
-tabled_proof_search Typeclasses Type PRoof :-
-  coq.say "TYPECLASSES" Typeclasses,
+  !.
+
+pred tabled_proof_search i:term o:term.
+tabled_proof_search Type PRoof :-
   MyGoal = assertion Type {{ _ }},
   tabled_typeclass_resolution MyGoal FinalAnswer,
-    !,
-
+  !,
   /* Convert from result to proof term! */
-
   FinalAnswer = assertion FinalType FinalTerm,
   FinalProof = FinalTerm,
   coq.say "FinalProof" {coq.term->string FinalProof},
   PRoof = FinalProof,
   coq.say "Proof" {coq.term->string PRoof} "Done"
-    .
-
+  .
 
 pred search_context i:list prop i:term o:term.
-search_context [decl Te N Ty | _] Type PRoof :-
+search_context [decl Te _ Ty | _] Type PRoof :-
   Ty = Type,
-  Te = PRoof,
-  coq.say "CHECK SUCC" N PRoof.
-search_context [_|Tl] Type PRoof :- search_context Tl Type PRoof.
+  Te = PRoof.
+search_context [_|Tl] Type PRoof :-
+  search_context Tl Type PRoof.
 
 solve (goal Ctx Trigger Type PRoof Args as G) V :-
-  coq.TC.db-tc Typeclasses,
-  coq.say "AGRS" Args Ctx,
-  coq.say "SEARCHING ..." {coq.term->string Type}, !,
-  coq.say "V" V,
-  (search_context Ctx Type PRoof ; tabled_proof_search Typeclasses Type PRoof),
-  coq.say "SUCCESS FINDING INSTANCE".
-
+  (search_context Ctx Type PRoof ; tabled_proof_search Type PRoof).
 
 solve _ _ :- coq.ltac.fail _ "No auto".
diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index 9fbf1c11b..365ed55cd 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -6,7 +6,34 @@ Elpi TC Solver Register TC.TabledSolver.
 
 Declare ML Module "rocq-elpi.tc-tabled".
 
+From elpi.apps.tc_tabled.elpi Extra Dependency "custom_map.elpi" as custom_map.
+From elpi.apps.tc_tabled.elpi Extra Dependency "map2.elpi" as map2.
 From elpi.apps.tc_tabled.elpi Extra Dependency "tabled_type_class.elpi" as TabledTC.
+
+Elpi Accumulate File custom_map.
+Elpi Accumulate File map2.
+
+Elpi Accumulate lp:{{
+  pred mymap_make i:(pred i:K, i:K, o:cmp), o:mymap K V.
+  pred mymap_find i:K i:(mymap K V) o:V.
+  pred mymap_add i:K i:V i:(mymap K V) o:(mymap K V).
+  pred mymap_update i:K i:V i:(mymap K V) o:(mymap K V).
+
+  %% typeabbrev (mymap K V) (custom_map K V).
+
+  %% mymap_make Cmp M :- custom_make Cmp M.
+  %% mymap_find K M V :- custom_find K M V.
+  %% mymap_add K V M M1 :- custom_add K V M M1.
+  %% mymap_update K V M M1 :- custom_add K V M M1.
+
+  typeabbrev (mymap K V) (std.map2 K V).
+
+  mymap_make Cmp M :- std.map2.make Cmp M.
+  mymap_find K M V :- std.map2.find K M V.
+  mymap_add K V M M1 :- std.map2.add K V M M1.
+  mymap_update K V M M1 :- std.map2.update K V M M1.
+}}.
+
 Elpi Accumulate File TabledTC.
 
 Elpi Export TC.TabledSolver.

From cd3cdba9f4101e2e954fc131d7df0335d161682b Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Tue, 12 Aug 2025 23:35:34 +0200
Subject: [PATCH 18/23] Cleaup

---
 apps/tc-tabled/elpi/custom_map.elpi | 6 ++----
 apps/tc-tabled/elpi/map2.elpi       | 6 +-----
 2 files changed, 3 insertions(+), 9 deletions(-)

diff --git a/apps/tc-tabled/elpi/custom_map.elpi b/apps/tc-tabled/elpi/custom_map.elpi
index 0cc1aeafa..c31e53bdc 100644
--- a/apps/tc-tabled/elpi/custom_map.elpi
+++ b/apps/tc-tabled/elpi/custom_map.elpi
@@ -56,10 +56,8 @@ update_index N V [ X | L ] [ X | O ] :-
 pred custom_add i:K, i:V, i:custom_map K V, o:custom_map K V.
 custom_add K V (custom_map M Cmp) (custom_map M1 Cmp) :-
   std.length M Len,
-  coq.say "Search",
   binary_search (pr K (_ /* dummy value */)) (cmp_fst_pair Cmp) 0 (Len - 1) M I Approx,
   if (Approx = tt)
-  (coq.say "Insert", insert_index I (pr K V) M M1) /* insert */
-  (coq.say "Update", update_index I (pr K V) M M1 ) /* update */
-  , coq.say "Done"
+     (insert_index I (pr K V) M M1) /* insert */
+     (update_index I (pr K V) M M1 ) /* update */
   , !.
diff --git a/apps/tc-tabled/elpi/map2.elpi b/apps/tc-tabled/elpi/map2.elpi
index 29f180366..8ef559e80 100644
--- a/apps/tc-tabled/elpi/map2.elpi
+++ b/apps/tc-tabled/elpi/map2.elpi
@@ -9,11 +9,7 @@ namespace std.map2 {
 
   % [find K M V] looks in M for the value V associated to K
   pred find i:K, i:std.map2 K V, o:V.
-  find K (std.map2 M Cmp) V :-
-    coq.say "Find",
-    private.find M Cmp K V,
-    coq.say "FY".
-  find _ _ _ :- coq.say "FN", fail.
+  find K (std.map2 M Cmp) V :- private.find M Cmp K V.
 
   % [add K V M M1] M1 is M where K is bound to V
   pred add i:K, i:V, i:std.map2 K V, o:std.map2 K V.

From ec1978362d4c1da2333382c450064be02e787dba Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Tue, 12 Aug 2025 23:40:12 +0200
Subject: [PATCH 19/23] Cleaup

---
 apps/tc-tabled/src/rocq_elpi_tc_tabled_hook.mlg | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/apps/tc-tabled/src/rocq_elpi_tc_tabled_hook.mlg b/apps/tc-tabled/src/rocq_elpi_tc_tabled_hook.mlg
index ef537fc66..b3a681efd 100644
--- a/apps/tc-tabled/src/rocq_elpi_tc_tabled_hook.mlg
+++ b/apps/tc-tabled/src/rocq_elpi_tc_tabled_hook.mlg
@@ -6,7 +6,4 @@ DECLARE PLUGIN "rocq-elpi.tc-tabled"
 {
 open Stdarg
 open Elpi_plugin
-(* open Rocq_elpi_arg_syntax *)
-(* open Rocq_elpi_tc_register *)
-(* open Rocq_elpi_class_tactics_takeover *)
 }

From 83f6e4a97e02a4287527b4126daae3927623ff80 Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Wed, 13 Aug 2025 22:48:45 +0200
Subject: [PATCH 20/23] Add update to map and do some testing for tower of
 diamonds

---
 apps/tc-tabled/elpi/map2.elpi               |  18 ++-
 apps/tc-tabled/elpi/tabled_type_class.elpi  |  24 +---
 apps/tc-tabled/tests/diamond.v              | 117 +++++++++++++++
 apps/tc-tabled/tests/dune                   |   8 ++
 apps/tc-tabled/theories/diamond.v           |  91 ------------
 apps/tc-tabled/theories/tabled_type_class.v | 149 +++++++++++++++++++-
 6 files changed, 284 insertions(+), 123 deletions(-)
 create mode 100644 apps/tc-tabled/tests/diamond.v
 create mode 100644 apps/tc-tabled/tests/dune
 delete mode 100644 apps/tc-tabled/theories/diamond.v

diff --git a/apps/tc-tabled/elpi/map2.elpi b/apps/tc-tabled/elpi/map2.elpi
index 8ef559e80..2a8a54449 100644
--- a/apps/tc-tabled/elpi/map2.elpi
+++ b/apps/tc-tabled/elpi/map2.elpi
@@ -14,7 +14,8 @@ namespace std.map2 {
   % [add K V M M1] M1 is M where K is bound to V
   pred add i:K, i:V, i:std.map2 K V, o:std.map2 K V.
   add K V (std.map2 M Cmp) (std.map2 M1 Cmp) :-
-    private.add M Cmp K V M1.
+    private.add M Cmp K VV M1,
+    VV = V.
 
   % [update K V M M1] M1 is M where K is bound to V
   pred update i:K, i:V, i:std.map2 K V, o:std.map2 K V.
@@ -45,10 +46,10 @@ namespace std.map2 {
 
     pred print_m i:(map K V) o:string.
     print_m (empty) "emtpy".
-    print_m (node L _ _ R I) S :-
+    print_m (node L _ _ R H) S :-
       print_m L SL,
       print_m R SR,
-      S is "(" ^ SL ^ "," ^ "," ^ SR ^ ")"
+      S is "(" ^ SL ^ "," ^ (int_to_string H) ^ "," ^ SR ^ ")"
       .
 
     pred bal i:map K V, i:K, i:V, i:map K V, o:map K V.
@@ -85,15 +86,12 @@ namespace std.map2 {
 
     pred update i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
     update (node _ X _ _ _ as M) Cmp X1 XD M1 :-
-      !, Cmp X1 X E, !, update.aux E M Cmp X1 XD M1, !.
+      Cmp X1 X E, update.aux E M Cmp X1 XD M1.
 
     pred update.aux i:cmp, i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
-    update.aux eq (node L _ _ R H) _   X XD T :-
-      T = node L X XD R H, !.
-    update.aux lt (node L V D R H) Cmp X XD T :-
-      T = node {update L Cmp X XD} V D R H, !.
-    update.aux gt (node L V D R H) Cmp X XD T :-
-      T = node L V D {update R Cmp X XD} H, !.
+    update.aux eq (node L V _ R H) _   X XD (node L V XD R H).
+    update.aux lt (node L V D R H) Cmp X XD (node LT V D R H) :- update L Cmp X XD LT, !.
+    update.aux gt (node L V D R H) Cmp X XD (node L V D RT H) :- update R Cmp X XD RT, !.
 
     pred find i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:V.
     find ((node L K1 V1 R _) as M) Cmp K V :-
diff --git a/apps/tc-tabled/elpi/tabled_type_class.elpi b/apps/tc-tabled/elpi/tabled_type_class.elpi
index 7db4fdf13..bed4e16d8 100644
--- a/apps/tc-tabled/elpi/tabled_type_class.elpi
+++ b/apps/tc-tabled/elpi/tabled_type_class.elpi
@@ -30,9 +30,6 @@ typeabbrev resume_stack (list (pair consumer_node assertion)).
 
 typeabbrev instance tc-instance.
 
-kind class_instances type.
-type class_instances mymap assertion (list instance) -> class_instances.
-
 kind generator_node type.
 type generator_node assertion -> list instance -> generator_node.
 
@@ -83,7 +80,8 @@ new_subgoal
   (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
   Subgoal Waiter
   (synth NewGeneratorStack ResumeStack NewAssertionTable RootAnswer) :-
-  mymap_add Subgoal (entry [Waiter] []) AssertionTable NewAssertionTable,
+  mymap_add Subgoal Entry AssertionTable NewAssertionTable,
+  Entry = (entry [Waiter] []),
   assertion_typeclass Subgoal Name,
   coq.TC.db-for Name Instances,
   NewGeneratorStack = [(generator_node Subgoal Instances) | GeneratorStack]
@@ -268,7 +266,8 @@ new_consumer_node
   /* for each solution to g, push new cnode onto resume stack with it */
   std.fold Waiters (pr ResumeStack RootAnswer) (waiter_fun Goal) (pr NewResumeStack NewRootAnswer),
   /* add new cnode to g's dependents */
-  mymap_update Goal (entry Waiters [ Goal | Answers ]) AssertionTable NewAssertionTable,
+  mymap_update Goal NewEntry AssertionTable NewAssertionTable,
+  NewEntry = (entry Waiters [ Goal | Answers ]),
   !.
 
 new_consumer_node
@@ -283,7 +282,8 @@ new_consumer_node
        std.append TempResumeStack ResumeStack NewResumeStack,
 
        NewWaiters = [ callback CN | Waiters ],
-       mymap_update Subgoal (entry NewWaiters Answers) AssertionTable NewAssertionTable,
+       mymap_update Subgoal NewEntry AssertionTable NewAssertionTable,
+       NewEntry = (entry NewWaiters Answers),
        NewGeneratorStack = GeneratorStack
      )
      (
@@ -350,18 +350,8 @@ tabled_typeclass_resolution_body (synth
 tabled_typeclass_resolution_body (synth [] [] _ _) _ _ _ :- fail.
 
 pred synth_loop i:synth i:assertion i:int o:assertion.
-synth_loop (synth _ _ _ (some Answer)) _ Fuel Answer.
+synth_loop (synth _ _ _ (some Answer)) _ Fuel Answer :- coq.say "synth round" Fuel.
 synth_loop MySynth Query Fuel FinalAnswer :-
-  /* Print debug info */
-  MySynth = synth Stack1 Stack2 _ _,
-  std.length Stack1 Stack1Len,
-  std.length Stack2 Stack2Len,
-  coq.say "synth round" Fuel,
-  ((Stack1 = [ generator_node (assertion (StkHd1T) (StkHd1V)) L1 | _ ] , coq.say Stack1Len "topG:" {coq.term->string StkHd1T} {coq.term->string StkHd1V} L1); true),
-  ((Stack2 = [ pr (consumer_node (assertion StkHd2T StkHd2V) _) (assertion AnsT AnsV) | _ ] , coq.say Stack2Len "topR:" {coq.term->string StkHd2T} {coq.term->string StkHd2V}, coq.say "answer:" {coq.term->string AnsT} {coq.term->string AnsV}); true),
-  coq.say "",
-  /* coq.say "synth round" Fuel Stack2 Stack1, */
-  /* endof - Print debug info */
   Fuel > 0,
   tabled_typeclass_resolution_body MySynth Query NextSynth FinalAnswer,
   !,
diff --git a/apps/tc-tabled/tests/diamond.v b/apps/tc-tabled/tests/diamond.v
new file mode 100644
index 000000000..768fd76e6
--- /dev/null
+++ b/apps/tc-tabled/tests/diamond.v
@@ -0,0 +1,117 @@
+(* https://github.com/leanprover/lean4/blob/master/tests/lean/run/typeclass_diamond.lean *)
+
+(* Diamond *)
+Class T (alpha : Type) (n : nat).
+Class R (alpha : Type) (n : nat).
+Class L (alpha : Type) (n : nat).
+Class B (alpha : Type) (n : nat).
+Instance BtL alpha n `{B alpha n} : L alpha n := {}.
+Instance BtR alpha n `{B alpha n} : R alpha n := {}.
+Instance LtR alpha n `{L alpha n} : T alpha n := {}.
+Instance RtR alpha n `{R alpha n} : T alpha n := {}.
+Instance TtR alpha n `{T alpha n} : B alpha (S n) := {}.
+
+Instance B0 alpha : B alpha 0 := {}.
+
+(* (* Finished transaction in 0. secs (0.u,0.s) (successful) *) *)
+(* Module Test0. Time Instance B_0 : B unit 0 := _. End Test0. *)
+
+(* (* Finished transaction in 1.389 secs (1.387u,0.s) (successful) *) *)
+(* Module Test225. Time Instance TtR225 : B unit 225 := _. End Test225. *)
+
+(* (* Finished transaction in 12.928 secs (12.913u,0.011s) (successful) *) *)
+(* Module Test450. Time Instance TtR450 : B unit 450 := _. End Test450. *)
+
+(* (* Finished transaction in 38.213 secs (38.175u,0.001s) (successful) *) *)
+(* Module Test675. Time Instance TtR675 : B unit 675 := _. End Test675. *)
+
+(* (* Finished transaction in 104.095 secs (103.999u,0.074s) (successful) *) *)
+(* Module Test900. Time Instance TtR900 : B unit 900 := _. End Test900. *)
+
+(* (* Finished transaction in 175.868 secs (175.7u,0.026s) (successful) *) *)
+(* Module Test1125. Time Instance TtR1125 : B unit 1125 := _. End Test1125. *)
+
+(* (* Finished transaction in 355.404 secs (355.286u,0.021s) (successful) *) *)
+(* Module Test1350. Time Instance B1350 : B unit 1350 := _. End Test1350. *)
+
+(* (* Finished transaction in 534.246 secs (533.92u,0.079s) (successful) *) *)
+(* Module Test1575. Time Instance TtR1575 : B unit 1575 := _. End Test1575. *)
+
+(* (* Finished transaction in 849.83 secs (849.087u,0.431s) (successful) *) *)
+(* Module Test1800. Time Instance B1800 : B unit 1800 := _. End Test1800. *)
+
+(* (* Finished transaction in 1098.921 secs (1098.166u,0.083s) (successful) *) *)
+(* Module Test2025. Time Instance TtR2025 : B unit 2025 := _. End Test2025. *)
+
+(* (* Finished transaction in 1441.027 secs (1439.305u,0.752s) (successful) *) *)
+(* Module Test2250. Time Instance B2250 : B unit 2250 := _. End Test2250. *)
+
+From elpi Require Import elpi.
+From elpi.apps Require Import tc.
+
+(* Elpi TC Solver Activate TC.Solver. *)
+Elpi TC Solver Override TC.Solver All.
+
+TC.AddAllClasses.
+TC.AddAllInstances.
+
+(* (* Finished transaction in 3.082 secs (3.052u,0.026s) (successful) *) *)
+(* (* Finished transaction in 5.362 secs (3.159u,0.319s) (successful) *) *)
+(* (* Finished transaction in 7.973 secs (3.183u,0.686s) (successful) *) *)
+(* Module Test700TC. Time Instance B700 : B unit 700 := _. End Test700TC. *)
+
+(* (* Finished transaction in 13.83 secs (13.794u,0.003s) (successful) *) *)
+(* (* Finished transaction in 12.364 secs (12.353u,0.s) (successful) *) *)
+(* (* Finished transaction in 12.292 secs (12.195u,0.019s) (successful) *) *)
+(* Module Test1400TC. Time Instance B1400 : B unit 1400 := _. End Test1400TC. *)
+
+(* (* Finished transaction in 29.792 secs (28.346u,0.261s) (successful) *) *)
+(* (* Finished transaction in 29.792 secs (28.346u,0.261s) (successful) *) *)
+(* Module Test2100TC. Time Instance B2100 : B unit 2100 := _. End Test2100TC. *)
+
+(* (* Finished transaction in 56.321 secs (54.822u,1.44s) (successful) *) *)
+(* Module Test2800TC. Time Instance B2800 : B unit 2800 := _. End Test2800TC. *)
+
+(* (* Finished transaction in 84.556 secs (82.008u,2.295s) (successful) *) *)
+(* Module Test3500TC. Time Instance B3500 : B unit 3500 := _. End Test3500TC. *)
+
+(*  *)
+Module Test4200TC. Time Instance B4200 : B unit 4200 := _. End Test4200TC.
+
+Elpi TC Solver Override TC.Solver None.
+
+(* From elpi.apps.tc_tabled Require Import tabled_typelass. *)
+
+(* (* Diamond example in Rocq *) *)
+(* Elpi TC Solver Activate TC.TabledSolver. *)
+(* Elpi TC Solver Override TC.TabledSolver All. *)
+
+(* (* Finished transaction in 1.911 secs (1.901u,0.007s) (successful) *) *)
+(* Module Test50Tabled. Time Instance B50 : B unit 50 := _. End Test50Tabled. (* Takes: 20000 - 19650 steps *) *)
+
+(* (* Finished transaction in 12.3 secs (12.253u,0.032s) (successful) *) *)
+(* Module Test100Tabled. Time Instance B100 : B unit 100 := _. End Test100Tabled. (* Takes: 20000 - 19300 steps *) *)
+
+(* (* Finished transaction in 50.408 secs (50.147u,0.152s) (successful) *) *)
+(* Module Test150Tabled. Time Instance B150 : B unit 150 := _. End Test150Tabled. (* Takes: 20000 - 18950 steps *) *)
+
+(* (* Finished transaction in 154.541 secs (153.917u,0.547s) (successful) *) *)
+(* Module Test200Tabled. Time Instance B200 : B unit 200 := _. End Test200Tabled. (* Takes: 20000 - 18600 steps *) *)
+
+(* (* Finished transaction in 435.689 secs (434.456u,0.983s) (successful) *) *)
+(* Module Test250Tabled. Time Instance B250 : B unit 250 := _. End Test250Tabled. (* Takes: 20000 - 18250 steps *) *)
+
+(* (* Finished transaction in 694.726 secs (693.17u,1.298s) (successful) *) *)
+(* Module Test300Tabled. Time Instance B300 : B unit 300 := _. End Test300Tabled. (* Takes: 20000 - 17900 steps *) *)
+
+(* (* Finished transaction in 1473.093 secs (1437.954u,6.426s) (successful) *) *)
+(* Module Test350Tabled. Time Instance B350 : B unit 350 := _. End Test350Tabled. (* Takes: 20000 - 17550 steps *) *)
+
+(* (* Finished transaction in 2457.3 secs (2447.5u,3.536s) (successful) *) *)
+(* Module Test400Tabled. Time Instance B400 : B unit 400 := _. End Test400Tabled. (* Takes: 20000 - 17200 steps *) *)
+
+(* (* Finished transaction in 3465.9 secs (3306.596u,16.99s) (successful) *) *)
+(* Module Test450Tabled. Time Instance B450 : B unit 450 := _. End Test450Tabled. (* Takes: 20000 - 16850 steps *) *)
+
+(* (*  *) *)
+(* Module Test500Tabled. Time Instance B500 : B unit 500 := _. End Test500Tabled. (* Takes: 20000 - 16500 steps *) *)
diff --git a/apps/tc-tabled/tests/dune b/apps/tc-tabled/tests/dune
new file mode 100644
index 000000000..89a9b7f79
--- /dev/null
+++ b/apps/tc-tabled/tests/dune
@@ -0,0 +1,8 @@
+(coq.theory
+ (name elpi.apps.tc_tabled.tests)
+ (flags :standard -async-proofs-cache force)
+ (package rocq-elpi-tests)
+ (theories elpi elpi.apps.tc elpi.apps.tc_tabled))
+
+(include_subdirs qualified)
+(dirs :standard \ WIP)
diff --git a/apps/tc-tabled/theories/diamond.v b/apps/tc-tabled/theories/diamond.v
deleted file mode 100644
index e92411e8e..000000000
--- a/apps/tc-tabled/theories/diamond.v
+++ /dev/null
@@ -1,91 +0,0 @@
-(* https://github.com/leanprover/lean4/blob/master/tests/lean/run/typeclass_diamond.lean *)
-
-(* Diamond *)
-Class T (alpha : Type) (n : nat).
-Class R (alpha : Type) (n : nat).
-Class L (alpha : Type) (n : nat).
-Class B (alpha : Type) (n : nat).
-Instance BtL alpha n `{B alpha n} : L alpha n := {}.
-Instance BtR alpha n `{B alpha n} : R alpha n := {}.
-Instance LtR alpha n `{L alpha n} : T alpha n := {}.
-Instance RtR alpha n `{R alpha n} : T alpha n := {}.
-Instance TtR alpha n `{T alpha n} : B alpha (S n) := {}.
-
-Instance B0 alpha : B alpha 0 := {}.
-
-(* Tabled: Finished transaction in 49.593 secs (49.415u,0.117s) (successful) *)
-(* Rocq: Finished transaction in 0.151 secs (0.151u,0.s) (successful) *)
-Module Test100. Time Instance TtR100 : B unit 100 := _. End Test100.
-
-(* Rocq: Finished transaction in 1.372 secs (1.195u,0.03s) (successful) *)
-Module Test200. Time Instance TtR200 : B unit 200 := _. End Test200.
-
-(* (* Rocq: Finished transaction in 4.842 secs (4.084u,0.147s) (successful) *) *)
-(* Module Test300. Time Instance TtR300 : B unit 300 := _. End Test300. *)
-
-(* (* Rocq: Finished transaction in 12.245 secs (11.568u,0.091s) (successful) *) *)
-(* Module Test400. Time Instance TtR400 : B unit 400 := _. End Test400. *)
-
-(* (* (* Rocq: Finished transaction in 23.508 secs (22.228u,0.258s) (successful) *) *) *)
-(* (* Module Test500. Time Instance TtR500 : B unit 500 := _. End Test500. *) *)
-
-(* (* (* Rocq: Finished transaction in 37.784 secs (37.582u,0.059s) (successful) *) *) *)
-(* (* Module Test600. Time Instance TtR600 : B unit 600 := _. End Test600. *) *)
-
-(* (* (* Rocq: Finished transaction in 66.476 secs (66.261u,0.106s) (successful) *) *) *)
-(* (* Module Test700. Time Instance TtR700 : B unit 700 := _. End Test700. *) *)
-
-(* (* (* Rocq: Finished transaction in 77.99 secs (77.174u,0.11s) (successful) *) *) *)
-(* (* Module Test800. Time Instance TtR800 : B unit 800 := _. End Test800. *) *)
-
-(* (* (* Rocq: Finished transaction in 106.952 secs (106.779u,0.025s) (successful) *) *) *)
-(* (* Module Test900. Time Instance TtR900 : B unit 900 := _. End Test900. *) *)
-
-(* (* (* Rocq: Finished transaction in 184.144 secs (183.71u,0.117s) (successful) *) *) *)
-(* (* Module Test1000. Time Instance TtR1000 : B unit 1000 := _. End Test1000. *) *)
-
-(* (* (* Ratio: ~ time: 2^(x/100) secs *) *) *)
-
-(* (* (* Rocq: Finished transaction in 1476.371 secs (1463.871u,3.989s) (successful) *) *) *)
-(* (* Module Test2000. Time Instance TtR2000 : B unit 2000 := _. End Test2000. *) *)
-
-From elpi Require Import elpi.
-From elpi.apps Require Import tc.
-
-(* Elpi TC Solver Activate TC.Solver. *)
-Elpi TC Solver Override TC.Solver All.
-
-TC.AddAllClasses.
-TC.AddAllInstances.
-
-(* TC: Finished transaction in 0.124 secs (0.122u,0.001s) (successful) *)
-Module Test100TC. Time Instance TtR100 : B unit 100 := _. End Test100TC.
-
-(* TC: Finished transaction in 0.313 secs (0.309u,0.003s) (successful) *)
-Module Test200TC. Time Instance TtR200 : B unit 200 := _. End Test200TC.
-
-(* TC: Finished transaction in 0.636 secs (0.629u,0.006s) (successful) *)
-Module Test300TC. Time Instance TtR300 : B unit 300 := _. End Test300TC.
-
-(* TC: Finished transaction in 1.082 secs (1.061u,0.02s) (successful) *)
-Module Test400TC. Time Instance TtR400 : B unit 400 := _. End Test400TC.
-
-Elpi TC Solver Override TC.Solver None.
-
-From elpi.apps.tc_tabled Require Import tabled_type_class.
-
-(* Diamond example in Rocq *)
-Elpi TC Solver Activate TC.TabledSolver.
-Elpi TC Solver Override TC.TabledSolver All.
-
-Module Test20Tabled. Time Instance TtR20 : B unit 20 := _. End Test20Tabled.
-
-(* (* Finished transaction in 55.794 secs (55.684u,0.097s) (successful) *) *)
-(* Module Test100Tabled. Time Instance TtR100 : B unit 100 := _. End Test100Tabled. *)
-
-(* (* Finished transaction in 737.925 secs (736.366u,0.837s) (successful) *) *)
-(* Module Test200Tabled. Time Instance TtR200 : B unit 200 := _. End Test200Tabled. *)
-
-(* Module Test300Tabled. Time Instance TtR300 : B unit 300 := _. End Test300Tabled. *)
-
-(* Module Test400Tabled. Time Instance TtR400 : B unit 400 := _. End Test400Tabled. *)
diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index 365ed55cd..ab17eaa17 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -9,9 +9,11 @@ Declare ML Module "rocq-elpi.tc-tabled".
 From elpi.apps.tc_tabled.elpi Extra Dependency "custom_map.elpi" as custom_map.
 From elpi.apps.tc_tabled.elpi Extra Dependency "map2.elpi" as map2.
 From elpi.apps.tc_tabled.elpi Extra Dependency "tabled_type_class.elpi" as TabledTC.
+From elpi.apps.tc_tabled.elpi Extra Dependency "avl.elpi" as avl.
 
 Elpi Accumulate File custom_map.
 Elpi Accumulate File map2.
+Elpi Accumulate File avl.
 
 Elpi Accumulate lp:{{
   pred mymap_make i:(pred i:K, i:K, o:cmp), o:mymap K V.
@@ -19,12 +21,14 @@ Elpi Accumulate lp:{{
   pred mymap_add i:K i:V i:(mymap K V) o:(mymap K V).
   pred mymap_update i:K i:V i:(mymap K V) o:(mymap K V).
 
-  %% typeabbrev (mymap K V) (custom_map K V).
+  /*
+  typeabbrev (mymap K V) (custom_map K V).
 
-  %% mymap_make Cmp M :- custom_make Cmp M.
-  %% mymap_find K M V :- custom_find K M V.
-  %% mymap_add K V M M1 :- custom_add K V M M1.
-  %% mymap_update K V M M1 :- custom_add K V M M1.
+  mymap_make Cmp M :- custom_make Cmp M.
+  mymap_find K M V :- custom_find K M V.
+  mymap_add K V M M1 :- custom_add K V M M1.
+  mymap_update K V M M1 :- custom_add K V M M1.
+  */
 
   typeabbrev (mymap K V) (std.map2 K V).
 
@@ -32,8 +36,143 @@ Elpi Accumulate lp:{{
   mymap_find K M V :- std.map2.find K M V.
   mymap_add K V M M1 :- std.map2.add K V M M1.
   mymap_update K V M M1 :- std.map2.update K V M M1.
+
+  /*
+  typeabbrev (mymap K V) (avl.tree K V).
+
+  mymap_make Cmp M :- avl.empty Cmp M.
+  mymap_find K M V :- avl.lookup_node K M V.
+  mymap_add K V M M1 :- avl.insert_node K V M M1.
+  mymap_update K V M M1 :- avl.update_node K V M M1.
+  */
 }}.
 
 Elpi Accumulate File TabledTC.
 
+(* Slow map test *)
+Elpi Accumulate lp:{{
+  pred map_test_fold i:int i:V i:V o:mymap int V.
+  map_test_fold I V U M :-
+    std.fold
+      {std.iota I}
+      {std.fold
+        {std.iota I}
+        {mymap_make cmp_term}
+        (k\m\ mymap_add k V m)
+      }
+      (k\m\ mymap_update k U m)
+      M
+    .
+}}.
+
+(* Elpi Accumulate lp:{{ *)
+(*   pred map_test_fold i:int, i:V, i:V, o:std.map int V. *)
+(*   map_test_fold I V U M :- *)
+(*    std.fold *)
+(*      {std.iota I} *)
+(*      {std.map.make cmp_term} *)
+(*      (k\m\ std.map.add k V m) /* insert */ *)
+(*      Mtemp, *)
+(*     std.fold *)
+(*       {std.iota I} *)
+(*       Mtemp *)
+(*       (k\m\ std.map.add k U m) /* update */ *)
+(*       M *)
+(*     . *)
+(* }}. *)
+
+(* Time Elpi Query lp:{{ *)
+(*   map_test_fold 6000 *)
+(*     {std.iota 20} *)
+(*     {std.iota 19} _. *)
+(* }}. *)
+
+Time Elpi Query lp:{{
+  map_test_fold 2000 {std.iota 20} {std.iota 19} _
+  .
+}}.
+
+(* Time Elpi Query lp:{{ *)
+(*   map_test_fold 6000 {std.iota 20} {std.iota 19} _ *)
+(*   . *)
+(* }}. *)
+
+(* Time Elpi Query lp:{{ *)
+(*   map_test_fold 7000 {std.iota 20} {std.iota 19} _ *)
+(*   . *)
+(* }}. *)
+
+(* Time Elpi Query lp:{{ *)
+(*   map_test_fold 8000 {std.iota 20} {std.iota 19} _ *)
+(*   . *)
+(* }}. *)
+
+(* Time Elpi Query lp:{{ *)
+(*   map_test_fold 9000 {std.iota 20} {std.iota 19} _ *)
+(*   . *)
+(* }}. *)
+
+(* Time Elpi Query lp:{{ *)
+(*   map_test_fold 10000 {std.iota 20} {std.iota 19} _ *)
+(*   . *)
+(* }}. *)
+
+(* Time Elpi Query lp:{{ *)
+(*   map_test_fold 11000 {std.iota 20} {std.iota 19} _ *)
+(*   . *)
+(* }}. *)
+
+(* Time Elpi Query lp:{{ *)
+(*   map_test_fold 12000 {std.iota 20} {std.iota 19} _ *)
+(*   . *)
+(* }}. *)
+
+(* Time Elpi Query lp:{{ *)
+(*   map_test_fold 13000 {std.iota 20} {std.iota 19} _ *)
+(*   . *)
+(* }}. *)
+
+(* Time Elpi Query lp:{{ *)
+(*   map_test_fold 14000 {std.iota 20} {std.iota 19} _ *)
+(*   . *)
+(* }}. *)
+
+(* Time Elpi Query lp:{{ *)
+(*   map_test_fold 28000 {std.iota 20} {std.iota 19} _ *)
+(*   . *)
+(* }}. *)
+
+Elpi Query lp:{{
+  coq.say "".
+}}.
+
 Elpi Export TC.TabledSolver.
+
+(* 6000: Finished transaction in 7.498 secs (7.454u,0.042s) (successful) *)
+(* 7000: Finished transaction in 11.687 secs (11.666u,0.003s) (successful) *)
+(* 8000: Finished transaction in 13.516 secs (13.502u,0.002s) (successful) *)
+(* 9000: Finished transaction in 16.214 secs (16.206u,0.002s) (successful) *)
+(* 10000: Finished transaction in 19.843 secs (19.817u,0.016s) (successful) *)
+(* 11000: Finished transaction in 24.429 secs (24.396u,0.002s) (successful) *)
+(* 12000: Finished transaction in 24.807 secs (24.791u,0.002s) (successful) *)
+(* 13000: Finished transaction in 32.366 secs (32.341u,0.008s) (successful) *)
+(* 14000: Finished transaction in 38.164 secs (38.044u,0.006s) (successful) *)
+
+(* Finished transaction in 37.175 secs (37.039u,0.128s) (successful) *)
+(* Finished transaction in 45.125 secs (45.017u,0.103s) (successful) *)
+(* Finished transaction in 58.736 secs (58.705u,0.026s) (successful) *)
+(* Finished transaction in 75.953 secs (75.914u,0.033s) (successful) *)
+(* Finished transaction in 97.66 secs (97.576u,0.075s) (successful) *)
+(* Finished transaction in 120.093 secs (120.063u,0.017s) (successful) *)
+(* Finished transaction in 147.584 secs (147.567u,0.001s) (successful) *)
+(* Finished transaction in 168.396 secs (168.328u,0.056s) (successful) *)
+(* Finished transaction in 197.791 secs (197.718u,0.057s) (successful) *)
+
+(* 3200 secs ~ 1 hour *)
+(* 866 secs ~ 14.5 min *)
+
+(* (6,37.175), (7,45.125), (8,58.736), (9,75.953), (10,97.66), (11,120.093), (12,147.584), (13,168.396), (14,197.791) *)
+(* 1.23069 x^2 - 4.04515 x + 14.5688 , R = 0.997845 *)
+
+
+(* 28000 *)

From b3934ee9b39f6e49ca4025cb644553f350939c55 Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Thu, 14 Aug 2025 16:18:48 +0200
Subject: [PATCH 21/23] Handle context variables

---
 apps/tc-tabled/elpi/assoc.elpi              | 184 ++++++++++++++++++++
 apps/tc-tabled/elpi/tabled_type_class.elpi  |  96 +++++-----
 apps/tc-tabled/tests/diamond.v              |  45 +++--
 apps/tc-tabled/theories/tabled_type_class.v | 128 --------------
 4 files changed, 267 insertions(+), 186 deletions(-)
 create mode 100644 apps/tc-tabled/elpi/assoc.elpi

diff --git a/apps/tc-tabled/elpi/assoc.elpi b/apps/tc-tabled/elpi/assoc.elpi
new file mode 100644
index 000000000..aa07acbe0
--- /dev/null
+++ b/apps/tc-tabled/elpi/assoc.elpi
@@ -0,0 +1,184 @@
+namespace avl {
+% -----------------------------------------
+% Types
+% -----------------------------------------
+
+kind tree type -> type -> type.
+type nil tree K V.
+type node tree K V -> K -> V -> int -> tree K V -> tree K V.
+
+kind cmp type.
+type lt cmp.
+type eq cmp.
+type gt cmp.
+
+% -----------------------------------------
+% Utilities
+% -----------------------------------------
+
+pred max i:int, i:int, o:int.
+max X Y X :- X >= Y.
+max X Y Y :- X < Y.
+
+pred height i:tree K V, o:int.
+height (nil) 0.
+height (node _ _ _ H _) H.
+
+pred balanceFactor i:tree K V, o:int.
+balanceFactor (nil) 0.
+balanceFactor (node L _ _ _ R) BF :-
+  height L HL,
+  height R HR,
+  BF is HL - HR.
+
+% -----------------------------------------
+% Rotations
+% -----------------------------------------
+
+pred rotateLeft i:tree K V, o:tree K V.
+rotateLeft (node L K V _ (node RL RK RV _ RR)) TOut :-
+  height L HL,
+  height RL HRL,
+  max HL HRL LMax,
+  HL1 is LMax + 1,
+  height RR HRR,
+  max HRL HRR RMax,
+  HR1 is RMax + 1,
+  TOut = node (node L K V HL1 RL) RK RV HR1 RR.
+
+pred rotateRight i:tree K V, o:tree K V.
+rotateRight (node (node LL LK LV _ LR) K V _ R) TOut :-
+  height LL HLL,
+  height LR HLR,
+  max HLL HLR LMax,
+  HL1 is LMax + 1,
+  height R HR,
+  max HLR HR RMax,
+  HR1 is RMax + 1,
+  TOut = node LL LK LV HL1 (node LR K V HR1 R).
+
+% -----------------------------------------
+% Balancing
+% -----------------------------------------
+
+pred balance i:tree K V, o:tree K V.
+balance (nil) (nil).
+balance (node L K V _ R) TOut :-
+  height L HL,
+  height R HR,
+  BF is HL - HR,
+  if (BF > 1)
+    (
+      balanceFactor L BFL,
+      if (BFL >= 0)
+        ( rotateRight (node L K V 0 R) TOut )
+        ( rotateLeft L L1, rotateRight (node L1 K V 0 R) TOut )
+    )
+    ( if (BF < -1)
+        (
+          balanceFactor R BFR,
+          if (BFR =< 0)
+            ( rotateLeft (node L K V 0 R) TOut )
+            ( rotateRight R R1, rotateLeft (node L K V 0 R1) TOut )
+        )
+        (
+          max HL HR M,
+          H is M + 1,
+          TOut = node L K V H R
+        )
+    ).
+
+% -----------------------------------------
+% Insertion
+% -----------------------------------------
+
+pred insert
+  i:(pred i:K, i:K, o:cmp),
+  i:K, i:V, i:tree K V, o:tree K V.
+
+insert _ K V (nil) (node (nil) K V 1 (nil)).
+insert Cmp K V (node L K0 V0 H R) TOut :-
+  Cmp K K0 Ord,
+  if (Ord = lt)
+    (
+      insert Cmp K V L L1,
+      height L1 HL,
+      height R HR,
+      max HL HR M,
+      H1 is M + 1,
+      balance (node L1 K0 V0 H1 R) TOut
+    )
+    ( if (Ord = gt)
+        (
+          insert Cmp K V R R1,
+          height L HL,
+          height R1 HR,
+          max HL HR M,
+          H1 is M + 1,
+          balance (node L K0 V0 H1 R1) TOut
+        )
+        ( % eq = update value
+          height L HL,
+          height R HR,
+          max HL HR M,
+          H1 is M + 1,
+          balance (node L K V H1 R) TOut
+        )
+    ).
+
+% -----------------------------------------
+% Update
+% -----------------------------------------
+
+pred update
+  i:(pred i:K, i:K, o:cmp),
+  i:K, i:V, i:tree K V, o:tree K V.
+
+update _ K V (nil) (node (nil) K V 1 (nil)).
+update Cmp K V (node L K0 V0 H R) TOut :-
+  Cmp K K0 Ord,
+  if (Ord = lt)
+    (
+      update Cmp K V L L1,
+      height L1 HL,
+      height R HR,
+      max HL HR M,
+      H1 is M + 1,
+      balance (node L1 K0 V0 H1 R) TOut
+    )
+    ( if (Ord = gt)
+        (
+          update Cmp K V R R1,
+          height L HL,
+          height R1 HR,
+          max HL HR M,
+          H1 is M + 1,
+          balance (node L K0 V0 H1 R1) TOut
+        )
+        ( % eq = update value
+          height L HL,
+          height R HR,
+          max HL HR M,
+          H1 is M + 1,
+          balance (node L K V H1 R) TOut
+        )
+    ).
+
+pred lookup
+  i:(pred i:K, i:K, o:cmp),
+  i:K,
+  i:tree K V,
+  o:V.
+
+lookup _ _ (nil) _ :- fail. % key not found
+
+lookup Cmp K (node L K0 V0 _ R) V :-
+  Cmp K K0 Ord,
+  if (Ord = lt)
+    ( lookup Cmp K L V )
+    ( if (Ord = gt)
+        ( lookup Cmp K R V )
+        ( V = V0 ) % eq
+    ).
+
+}
\ No newline at end of file
diff --git a/apps/tc-tabled/elpi/tabled_type_class.elpi b/apps/tc-tabled/elpi/tabled_type_class.elpi
index bed4e16d8..2e747f249 100644
--- a/apps/tc-tabled/elpi/tabled_type_class.elpi
+++ b/apps/tc-tabled/elpi/tabled_type_class.elpi
@@ -28,7 +28,8 @@ type entry list waiter -> list assertion -> entry.
 
 typeabbrev resume_stack (list (pair consumer_node assertion)).
 
-typeabbrev instance tc-instance.
+% typeabbrev instance tc-instance.
+typeabbrev instance pair term term.
 
 kind generator_node type.
 type generator_node assertion -> list instance -> generator_node.
@@ -38,6 +39,7 @@ type synth list generator_node ->
   resume_stack ->
   mymap assertion entry ->
   option assertion ->
+  list goal-ctx ->
   synth.
 
 pred type_equal i:ty i:ty o:cmp.
@@ -75,16 +77,30 @@ term_typeclass (prod X T F) N :-
 pred assertion_typeclass i:assertion o:gref.
 assertion_typeclass (assertion G _) Name :- term_typeclass G Name.
 
+pred context_instances i:list goal-ctx i:gref o:list instance.
+context_instances [] _ [].
+context_instances [decl V _ T | XS] Name O :-
+  (if (term_typeclass T Name) (O = [ (pr T V) | OS ]) (O = OS)),
+  context_instances XS Name OS.
+
+pred tc_to_inst i:tc-instance o:instance.
+tc_to_inst (tc-instance BI _ as TcInst) (pr B BITm) :-
+  tc_instance_to_term TcInst B,
+  coq.env.global BI BITm.
+
 pred new_subgoal i:synth i:assertion i:waiter o:synth.
 new_subgoal
-  (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+  (synth GeneratorStack ResumeStack AssertionTable RootAnswer Ctx)
   Subgoal Waiter
-  (synth NewGeneratorStack ResumeStack NewAssertionTable RootAnswer) :-
+  (synth NewGeneratorStack ResumeStack NewAssertionTable RootAnswer Ctx) :-
   mymap_add Subgoal Entry AssertionTable NewAssertionTable,
   Entry = (entry [Waiter] []),
   assertion_typeclass Subgoal Name,
-  coq.TC.db-for Name Instances,
-  NewGeneratorStack = [(generator_node Subgoal Instances) | GeneratorStack]
+  coq.TC.db-for Name TcInstances,
+  std.map TcInstances tc_to_inst Instances,
+  context_instances Ctx Name CtxInstances,
+  std.append CtxInstances Instances AllInstances,
+  NewGeneratorStack = [(generator_node Subgoal AllInstances) | GeneratorStack]
   .
 
 /* Apply answer to goal and update meta variable context if it succeeds */
@@ -236,12 +252,12 @@ filter_metavariables [] [].
 
 
 pred try_resolve i:assertion i:instance o:assertion o:list assertion.
-try_resolve (assertion A _) (tc-instance BI _) (assertion RT RV) RL :-
-  tc_instance_to_term (tc-instance BI _) B,
-  coq.env.global BI BITm,
-  coq.gref->string BI BIName,
-  BI = const (BIConst),
-  coq.env.const BIConst (some BIBody) BITy,
+try_resolve (assertion A _) (pr B BITm) (assertion RT RV) RL :-
+  % tc_instance_to_term (tc-instance BI _) B,
+  % coq.env.global BI BITm,
+  % coq.gref->string BI BIName,
+  % BI = const (BIConst),
+  % coq.env.const BIConst (some BIBody) BITy,
   try_resolve_types A B OL L,
   filter_metavariables L RL,
     !,
@@ -254,13 +270,13 @@ temp_fun A B (pr A B).
 
 pred waiter_fun i:assertion i:waiter i:(pair (resume_stack) (option assertion)) o:(pair (resume_stack) (option assertion)).
 waiter_fun Answer root (pr A _) (pr A (some Answer)).
-waiter_fun Answer (callback C) (pr A R) (pr [pr C Answer /* Goal */ | A] R).
+waiter_fun Answer (callback C) (pr A R) (pr [pr C Answer | A] R).
 
 pred new_consumer_node i:synth i:consumer_node o:synth.
 new_consumer_node
-    (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+    (synth GeneratorStack ResumeStack AssertionTable RootAnswer Ctx)
     (consumer_node Goal [])
-    (synth GeneratorStack NewResumeStack NewAssertionTable NewRootAnswer) :-
+    (synth GeneratorStack NewResumeStack NewAssertionTable NewRootAnswer Ctx) :-
   /* for each solution to g, push new cnode onto resume stack with it */
   mymap_find Goal AssertionTable (entry Waiters Answers),
   /* for each solution to g, push new cnode onto resume stack with it */
@@ -271,9 +287,9 @@ new_consumer_node
   !.
 
 new_consumer_node
-    (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+    (synth GeneratorStack ResumeStack AssertionTable RootAnswer Ctx)
     (consumer_node _ [ Subgoal | _ ] as CN)
-    (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer) :-
+    (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer Ctx) :-
   if (mymap_find Subgoal AssertionTable (entry Waiters Answers))
      (
        /* Map answers with consumer node */
@@ -288,21 +304,21 @@ new_consumer_node
      )
      (
        new_subgoal
-         (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+         (synth GeneratorStack ResumeStack AssertionTable RootAnswer Ctx)
          Subgoal
          (callback CN)
-         (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer)
+         (synth NewGeneratorStack NewResumeStack NewAssertionTable RootAnswer Ctx)
      ),
      !.
 
 new_consumer_node _ _ _ :- coq.error "Failed new consumer node!" , fail.
 
 pred tabled_typeclass_resolution_body i:synth i:assertion o:synth o:assertion.
-tabled_typeclass_resolution_body (synth _ _ _ (some Answer)) _ _ Answer.
+tabled_typeclass_resolution_body (synth _ _ _ (some Answer) _) _ _ Answer.
 
 tabled_typeclass_resolution_body (synth GeneratorStack
 				  [ (pr (consumer_node Goal [ Subgoal | Remaining ]) Answer) | ResumeStack ]
-				  AssertionTable RootAnswer)
+				  AssertionTable RootAnswer Ctx)
     Query MySynth FinalAnswer :-
   Answer = assertion AnswerT AnswerV,
   coq.typecheck AnswerV AnswerNT ok,
@@ -310,47 +326,49 @@ tabled_typeclass_resolution_body (synth GeneratorStack
   if (try_answer Subgoal NewAnswer Goal UpdatedGoal Remaining UpdatedRemaining)
      (
        new_consumer_node
-         (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+         (synth GeneratorStack ResumeStack AssertionTable RootAnswer Ctx)
          (consumer_node UpdatedGoal UpdatedRemaining) /* TODO: Was Goal in code, but should add new solution? */
          MySynth
       )
       (
-        MySynth = (synth GeneratorStack ResumeStack AssertionTable RootAnswer)
+        MySynth = (synth GeneratorStack ResumeStack AssertionTable RootAnswer Ctx)
       ).
 
 tabled_typeclass_resolution_body (synth GeneratorStack
 				  [ (pr (consumer_node Goal []) Answer) | ResumeStack ]
-				  AssertionTable RootAnswer)
+				  AssertionTable RootAnswer Ctx)
     Query MySynth FinalAnswer :-
   coq.warn "Cannot resume with empty subgoals!",
   fail.
 
 tabled_typeclass_resolution_body
   (synth [ generator_node Goal [Instance | Instances ] | GeneratorStack ]
-    ResumeStack AssertionTable RootAnswer) Query NewSynth FinalAnswer :-
+    ResumeStack AssertionTable RootAnswer Ctx) Query NewSynth FinalAnswer :-
   if (try_resolve Goal Instance Resolved Subgoals)
      (
        /* else (l. 14) */
        new_consumer_node
-         (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
+         (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer Ctx)
          (consumer_node Resolved Subgoals) NewSynth
      )
      (
        /* If first subgoal of cnode does not resolve with solution then Continue */
-       NewSynth = (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer)
+       NewSynth = (synth [ generator_node Goal Instances | GeneratorStack ] ResumeStack AssertionTable RootAnswer Ctx)
      ).
 
 tabled_typeclass_resolution_body (synth
 				  [ generator_node _ [] | GeneratorStack ]
-				  ResumeStack AssertionTable RootAnswer)
+				  ResumeStack AssertionTable RootAnswer Ctx)
     Query
-    (synth GeneratorStack ResumeStack AssertionTable RootAnswer) FinalAnswer.
+    (synth GeneratorStack ResumeStack AssertionTable RootAnswer Ctx) FinalAnswer.
 /* If cnode has no remaining subgoals then (ll.7-13) .. */
 
-tabled_typeclass_resolution_body (synth [] [] _ _) _ _ _ :- fail.
+tabled_typeclass_resolution_body (synth [] [] _ _ _) _ _ _ :-
+  coq.warn "Failed to find instance: Nothing left to test",
+  fail.
 
 pred synth_loop i:synth i:assertion i:int o:assertion.
-synth_loop (synth _ _ _ (some Answer)) _ Fuel Answer :- coq.say "synth round" Fuel.
+synth_loop (synth _ _ _ (some Answer) _) _ Fuel Answer :- coq.say "synth round" Fuel.
 synth_loop MySynth Query Fuel FinalAnswer :-
   Fuel > 0,
   tabled_typeclass_resolution_body MySynth Query NextSynth FinalAnswer,
@@ -358,25 +376,23 @@ synth_loop MySynth Query Fuel FinalAnswer :-
   NextFuel is Fuel - 1,
   synth_loop NextSynth Query NextFuel FinalAnswer.
 
-pred tabled_typeclass_resolution i:assertion o:assertion.
-tabled_typeclass_resolution Query FinalAnswer :-
+pred tabled_typeclass_resolution i:list goal-ctx i:assertion o:assertion.
+tabled_typeclass_resolution Ctx Query FinalAnswer :-
   mymap_make assertion_equal AssertionTableEmpty,
-  new_subgoal (synth [] [] AssertionTableEmpty none) Query root MySynth,
+  new_subgoal (synth [] [] AssertionTableEmpty none Ctx) Query root MySynth,
   /* while true do */
   synth_loop MySynth Query 20000 FinalAnswer,
   !.
 
-pred tabled_proof_search i:term o:term.
-tabled_proof_search Type PRoof :-
+pred tabled_proof_search i:list goal-ctx i:term o:term.
+tabled_proof_search Ctx Type PRoof :-
   MyGoal = assertion Type {{ _ }},
-  tabled_typeclass_resolution MyGoal FinalAnswer,
+  tabled_typeclass_resolution Ctx MyGoal FinalAnswer,
   !,
   /* Convert from result to proof term! */
   FinalAnswer = assertion FinalType FinalTerm,
   FinalProof = FinalTerm,
-  coq.say "FinalProof" {coq.term->string FinalProof},
-  PRoof = FinalProof,
-  coq.say "Proof" {coq.term->string PRoof} "Done"
+  PRoof = FinalProof
   .
 
 pred search_context i:list prop i:term o:term.
@@ -387,6 +403,6 @@ search_context [_|Tl] Type PRoof :-
   search_context Tl Type PRoof.
 
 solve (goal Ctx Trigger Type PRoof Args as G) V :-
-  (search_context Ctx Type PRoof ; tabled_proof_search Type PRoof).
+  (search_context Ctx Type PRoof ; tabled_proof_search Ctx Type PRoof).
 
 solve _ _ :- coq.ltac.fail _ "No auto".
diff --git a/apps/tc-tabled/tests/diamond.v b/apps/tc-tabled/tests/diamond.v
index 768fd76e6..69e411fd3 100644
--- a/apps/tc-tabled/tests/diamond.v
+++ b/apps/tc-tabled/tests/diamond.v
@@ -1,17 +1,17 @@
 (* https://github.com/leanprover/lean4/blob/master/tests/lean/run/typeclass_diamond.lean *)
 
 (* Diamond *)
-Class T (alpha : Type) (n : nat).
-Class R (alpha : Type) (n : nat).
-Class L (alpha : Type) (n : nat).
-Class B (alpha : Type) (n : nat).
-Instance BtL alpha n `{B alpha n} : L alpha n := {}.
-Instance BtR alpha n `{B alpha n} : R alpha n := {}.
-Instance LtR alpha n `{L alpha n} : T alpha n := {}.
-Instance RtR alpha n `{R alpha n} : T alpha n := {}.
-Instance TtR alpha n `{T alpha n} : B alpha (S n) := {}.
-
-Instance B0 alpha : B alpha 0 := {}.
+Class T (α : Type) (n : nat).
+Class R (α : Type) (n : nat).
+Class L (α : Type) (n : nat).
+Class B (α : Type) (n : nat).
+Instance BtL α n `{B α n} : L α n := {}.
+Instance BtR α n `{B α n} : R α n := {}.
+Instance LtR α n `{L α n} : T α n := {}.
+Instance RtR α n `{R α n} : T α n := {}.
+Instance TtR α n `{T α n} : B α (S n) := {}.
+
+Instance B0 α : B α 0 := {}.
 
 (* (* Finished transaction in 0. secs (0.u,0.s) (successful) *) *)
 (* Module Test0. Time Instance B_0 : B unit 0 := _. End Test0. *)
@@ -75,16 +75,25 @@ TC.AddAllInstances.
 (* (* Finished transaction in 84.556 secs (82.008u,2.295s) (successful) *) *)
 (* Module Test3500TC. Time Instance B3500 : B unit 3500 := _. End Test3500TC. *)
 
-(*  *)
-Module Test4200TC. Time Instance B4200 : B unit 4200 := _. End Test4200TC.
+(* (* Finished transaction in 132.134 secs (125.754u,3.332s) (successful) *) *)
+(* Module Test4200TC. Time Instance B4200 : B unit 4200 := _. End Test4200TC. *)
+
+(* Finished transaction in 198.935 secs (162.925u,7.034s) (successful) *)
+(* Module Test4900TC. Time Instance B4900 : B unit 4900 := _. End Test4900TC. *)
+
+(* (* Stack overflow *) *)
+(* (* Module Test5600TC. Time Instance B5600 : B unit 5600 := _. End Test5600TC. *) *)
 
 Elpi TC Solver Override TC.Solver None.
 
-(* From elpi.apps.tc_tabled Require Import tabled_typelass. *)
+From elpi.apps.tc_tabled Require Import tabled_type_class.
+
+(* Diamond example in Rocq *)
+Elpi TC Solver Activate TC.TabledSolver.
+Elpi TC Solver Override TC.TabledSolver All.
 
-(* (* Diamond example in Rocq *) *)
-(* Elpi TC Solver Activate TC.TabledSolver. *)
-(* Elpi TC Solver Override TC.TabledSolver All. *)
+(* Finished transaction in 1.911 secs (1.901u,0.007s) (successful) *)
+Module Test50Tabled. Time Instance B50 : B unit 50 := _. End Test50Tabled. (* Takes: 20000 - 19650 steps *)
 
 (* (* Finished transaction in 1.911 secs (1.901u,0.007s) (successful) *) *)
 (* Module Test50Tabled. Time Instance B50 : B unit 50 := _. End Test50Tabled. (* Takes: 20000 - 19650 steps *) *)
@@ -113,5 +122,5 @@ Elpi TC Solver Override TC.Solver None.
 (* (* Finished transaction in 3465.9 secs (3306.596u,16.99s) (successful) *) *)
 (* Module Test450Tabled. Time Instance B450 : B unit 450 := _. End Test450Tabled. (* Takes: 20000 - 16850 steps *) *)
 
-(* (*  *) *)
+(* (* Finished transaction in 4962.323 secs (4843.782u,17.345s) (successful) *) *)
 (* Module Test500Tabled. Time Instance B500 : B unit 500 := _. End Test500Tabled. (* Takes: 20000 - 16500 steps *) *)
diff --git a/apps/tc-tabled/theories/tabled_type_class.v b/apps/tc-tabled/theories/tabled_type_class.v
index ab17eaa17..5bb1f2042 100644
--- a/apps/tc-tabled/theories/tabled_type_class.v
+++ b/apps/tc-tabled/theories/tabled_type_class.v
@@ -9,11 +9,9 @@ Declare ML Module "rocq-elpi.tc-tabled".
 From elpi.apps.tc_tabled.elpi Extra Dependency "custom_map.elpi" as custom_map.
 From elpi.apps.tc_tabled.elpi Extra Dependency "map2.elpi" as map2.
 From elpi.apps.tc_tabled.elpi Extra Dependency "tabled_type_class.elpi" as TabledTC.
-From elpi.apps.tc_tabled.elpi Extra Dependency "avl.elpi" as avl.
 
 Elpi Accumulate File custom_map.
 Elpi Accumulate File map2.
-Elpi Accumulate File avl.
 
 Elpi Accumulate lp:{{
   pred mymap_make i:(pred i:K, i:K, o:cmp), o:mymap K V.
@@ -49,130 +47,4 @@ Elpi Accumulate lp:{{
 
 Elpi Accumulate File TabledTC.
 
-(* Slow map test *)
-Elpi Accumulate lp:{{
-  pred map_test_fold i:int i:V i:V o:mymap int V.
-  map_test_fold I V U M :-
-    std.fold
-      {std.iota I}
-      {std.fold
-        {std.iota I}
-        {mymap_make cmp_term}
-        (k\m\ mymap_add k V m)
-      }
-      (k\m\ mymap_update k U m)
-      M
-    .
-}}.
-
-(* Elpi Accumulate lp:{{ *)
-(*   pred map_test_fold i:int, i:V, i:V, o:std.map int V. *)
-(*   map_test_fold I V U M :- *)
-(*    std.fold *)
-(*      {std.iota I} *)
-(*      {std.map.make cmp_term} *)
-(*      (k\m\ std.map.add k V m) /* insert */ *)
-(*      Mtemp, *)
-(*     std.fold *)
-(*       {std.iota I} *)
-(*       Mtemp *)
-(*       (k\m\ std.map.add k U m) /* update */ *)
-(*       M *)
-(*     . *)
-(* }}. *)
-
-(* Time Elpi Query lp:{{ *)
-(*   map_test_fold 6000 *)
-(*     {std.iota 20} *)
-(*     {std.iota 19} _. *)
-(* }}. *)
-
-Time Elpi Query lp:{{
-  map_test_fold 2000 {std.iota 20} {std.iota 19} _
-  .
-}}.
-
-(* Time Elpi Query lp:{{ *)
-(*   map_test_fold 6000 {std.iota 20} {std.iota 19} _ *)
-(*   . *)
-(* }}. *)
-
-(* Time Elpi Query lp:{{ *)
-(*   map_test_fold 7000 {std.iota 20} {std.iota 19} _ *)
-(*   . *)
-(* }}. *)
-
-(* Time Elpi Query lp:{{ *)
-(*   map_test_fold 8000 {std.iota 20} {std.iota 19} _ *)
-(*   . *)
-(* }}. *)
-
-(* Time Elpi Query lp:{{ *)
-(*   map_test_fold 9000 {std.iota 20} {std.iota 19} _ *)
-(*   . *)
-(* }}. *)
-
-(* Time Elpi Query lp:{{ *)
-(*   map_test_fold 10000 {std.iota 20} {std.iota 19} _ *)
-(*   . *)
-(* }}. *)
-
-(* Time Elpi Query lp:{{ *)
-(*   map_test_fold 11000 {std.iota 20} {std.iota 19} _ *)
-(*   . *)
-(* }}. *)
-
-(* Time Elpi Query lp:{{ *)
-(*   map_test_fold 12000 {std.iota 20} {std.iota 19} _ *)
-(*   . *)
-(* }}. *)
-
-(* Time Elpi Query lp:{{ *)
-(*   map_test_fold 13000 {std.iota 20} {std.iota 19} _ *)
-(*   . *)
-(* }}. *)
-
-(* Time Elpi Query lp:{{ *)
-(*   map_test_fold 14000 {std.iota 20} {std.iota 19} _ *)
-(*   . *)
-(* }}. *)
-
-(* Time Elpi Query lp:{{ *)
-(*   map_test_fold 28000 {std.iota 20} {std.iota 19} _ *)
-(*   . *)
-(* }}. *)
-
-Elpi Query lp:{{
-  coq.say "".
-}}.
-
 Elpi Export TC.TabledSolver.
-
-(* 6000: Finished transaction in 7.498 secs (7.454u,0.042s) (successful) *)
-(* 7000: Finished transaction in 11.687 secs (11.666u,0.003s) (successful) *)
-(* 8000: Finished transaction in 13.516 secs (13.502u,0.002s) (successful) *)
-(* 9000: Finished transaction in 16.214 secs (16.206u,0.002s) (successful) *)
-(* 10000: Finished transaction in 19.843 secs (19.817u,0.016s) (successful) *)
-(* 11000: Finished transaction in 24.429 secs (24.396u,0.002s) (successful) *)
-(* 12000: Finished transaction in 24.807 secs (24.791u,0.002s) (successful) *)
-(* 13000: Finished transaction in 32.366 secs (32.341u,0.008s) (successful) *)
-(* 14000: Finished transaction in 38.164 secs (38.044u,0.006s) (successful) *)
-
-(* Finished transaction in 37.175 secs (37.039u,0.128s) (successful) *)
-(* Finished transaction in 45.125 secs (45.017u,0.103s) (successful) *)
-(* Finished transaction in 58.736 secs (58.705u,0.026s) (successful) *)
-(* Finished transaction in 75.953 secs (75.914u,0.033s) (successful) *)
-(* Finished transaction in 97.66 secs (97.576u,0.075s) (successful) *)
-(* Finished transaction in 120.093 secs (120.063u,0.017s) (successful) *)
-(* Finished transaction in 147.584 secs (147.567u,0.001s) (successful) *)
-(* Finished transaction in 168.396 secs (168.328u,0.056s) (successful) *)
-(* Finished transaction in 197.791 secs (197.718u,0.057s) (successful) *)
-
-(* 3200 secs ~ 1 hour *)
-(* 866 secs ~ 14.5 min *)
-
-(* (6,37.175), (7,45.125), (8,58.736), (9,75.953), (10,97.66), (11,120.093), (12,147.584), (13,168.396), (14,197.791) *)
-(* 1.23069 x^2 - 4.04515 x + 14.5688 , R = 0.997845 *)
-
-
-(* 28000 *)

From 5f159c26831198f296e903bbf9036c00c9965e37 Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Thu, 14 Aug 2025 17:09:42 +0200
Subject: [PATCH 22/23] Try to handle local definitions better (TODO: fix
 Context in section)

---
 apps/tc-tabled/elpi/tabled_type_class.elpi | 36 ++++++++++++++++------
 1 file changed, 27 insertions(+), 9 deletions(-)

diff --git a/apps/tc-tabled/elpi/tabled_type_class.elpi b/apps/tc-tabled/elpi/tabled_type_class.elpi
index 2e747f249..ee3b5dc2d 100644
--- a/apps/tc-tabled/elpi/tabled_type_class.elpi
+++ b/apps/tc-tabled/elpi/tabled_type_class.elpi
@@ -39,7 +39,7 @@ type synth list generator_node ->
   resume_stack ->
   mymap assertion entry ->
   option assertion ->
-  list goal-ctx ->
+  list (pair term term) ->
   synth.
 
 pred type_equal i:ty i:ty o:cmp.
@@ -77,9 +77,9 @@ term_typeclass (prod X T F) N :-
 pred assertion_typeclass i:assertion o:gref.
 assertion_typeclass (assertion G _) Name :- term_typeclass G Name.
 
-pred context_instances i:list goal-ctx i:gref o:list instance.
+pred context_instances i:list (pair term term) i:gref o:list instance.
 context_instances [] _ [].
-context_instances [decl V _ T | XS] Name O :-
+context_instances [pr T V | XS] Name O :-
   (if (term_typeclass T Name) (O = [ (pr T V) | OS ]) (O = OS)),
   context_instances XS Name OS.
 
@@ -363,7 +363,7 @@ tabled_typeclass_resolution_body (synth
     (synth GeneratorStack ResumeStack AssertionTable RootAnswer Ctx) FinalAnswer.
 /* If cnode has no remaining subgoals then (ll.7-13) .. */
 
-tabled_typeclass_resolution_body (synth [] [] _ _ _) _ _ _ :-
+tabled_typeclass_resolution_body (synth [] [] _ _ Ctx) _ _ _ :-
   coq.warn "Failed to find instance: Nothing left to test",
   fail.
 
@@ -376,7 +376,7 @@ synth_loop MySynth Query Fuel FinalAnswer :-
   NextFuel is Fuel - 1,
   synth_loop NextSynth Query NextFuel FinalAnswer.
 
-pred tabled_typeclass_resolution i:list goal-ctx i:assertion o:assertion.
+pred tabled_typeclass_resolution i:list (pair term term) i:assertion o:assertion.
 tabled_typeclass_resolution Ctx Query FinalAnswer :-
   mymap_make assertion_equal AssertionTableEmpty,
   new_subgoal (synth [] [] AssertionTableEmpty none Ctx) Query root MySynth,
@@ -384,10 +384,28 @@ tabled_typeclass_resolution Ctx Query FinalAnswer :-
   synth_loop MySynth Query 20000 FinalAnswer,
   !.
 
-pred tabled_proof_search i:list goal-ctx i:term o:term.
-tabled_proof_search Ctx Type PRoof :-
+pred context_to_arg_pairs i:list goal-ctx o:list (pair term term).
+context_to_arg_pairs [] [].
+context_to_arg_pairs [ decl V _ T | XS ] [ pr T V | YS ] :-
+  !, context_to_arg_pairs XS YS.
+context_to_arg_pairs [ _ | XS ] YS :-
+  context_to_arg_pairs XS YS.
+
+pred args_to_arg_pairs i:list argument o:list (pair term term).
+args_to_arg_pairs [] [].
+args_to_arg_pairs [ ctx-decl (context-item _ _ _ _ _ as CtxI) | XS ] [ pr T V | YS ] :-
+  !,
+  args_to_arg_pairs XS YS.
+args_to_arg_pairs [ _ | XS ] YS :-
+  args_to_arg_pairs XS YS.
+
+pred tabled_proof_search i:list goal-ctx i:list argument i:term o:term.
+tabled_proof_search Ctx Args Type PRoof :-
   MyGoal = assertion Type {{ _ }},
-  tabled_typeclass_resolution Ctx MyGoal FinalAnswer,
+  context_to_arg_pairs Ctx CtxPairs,
+  args_to_arg_pairs Args ArgsPairs,
+  std.append CtxPairs ArgsPairs CtxInstances,
+  tabled_typeclass_resolution CtxInstances MyGoal FinalAnswer,
   !,
   /* Convert from result to proof term! */
   FinalAnswer = assertion FinalType FinalTerm,
@@ -403,6 +421,6 @@ search_context [_|Tl] Type PRoof :-
   search_context Tl Type PRoof.
 
 solve (goal Ctx Trigger Type PRoof Args as G) V :-
-  (search_context Ctx Type PRoof ; tabled_proof_search Ctx Type PRoof).
+  (search_context Ctx Type PRoof ; tabled_proof_search Ctx Args Type PRoof).
 
 solve _ _ :- coq.ltac.fail _ "No auto".

From 1d6b0a7c60bcdf3109bdad31eeb49306c033630d Mon Sep 17 00:00:00 2001
From: Lasse Letager Hansen <letager@cs.au.dk>
Date: Fri, 15 Aug 2025 17:34:26 +0200
Subject: [PATCH 23/23] Fixed diamond test

---
 apps/tc-tabled/tests/diamond.v | 207 +++++++++++++++++++++------------
 1 file changed, 131 insertions(+), 76 deletions(-)

diff --git a/apps/tc-tabled/tests/diamond.v b/apps/tc-tabled/tests/diamond.v
index 69e411fd3..7b1c5d617 100644
--- a/apps/tc-tabled/tests/diamond.v
+++ b/apps/tc-tabled/tests/diamond.v
@@ -1,88 +1,114 @@
 (* https://github.com/leanprover/lean4/blob/master/tests/lean/run/typeclass_diamond.lean *)
 
 (* Diamond *)
-Class T (α : Type) (n : nat).
-Class R (α : Type) (n : nat).
-Class L (α : Type) (n : nat).
-Class B (α : Type) (n : nat).
-Instance BtL α n `{B α n} : L α n := {}.
-Instance BtR α n `{B α n} : R α n := {}.
-Instance LtR α n `{L α n} : T α n := {}.
-Instance RtR α n `{R α n} : T α n := {}.
-Instance TtR α n `{T α n} : B α (S n) := {}.
+Class Top1   (n : nat) : Type.
+Class Bot1   (n : nat) : Type.
+Class Left1  (n : nat) : Type.
+Class Right1 (n : nat) : Type.
 
-Instance B0 α : B α 0 := {}.
+Instance Bot1Inst : Bot1 0 := {}.
+Instance Left1ToBot1   (n : nat) `{Left1 n}  : Bot1 n := {}.
 
-(* (* Finished transaction in 0. secs (0.u,0.s) (successful) *) *)
-(* Module Test0. Time Instance B_0 : B unit 0 := _. End Test0. *)
+Instance Right1ToBot1  (n : nat) `{Right1 n} : Bot1 n := {}.
+Instance Top1ToLeft1   (n : nat) `{Top1 n}   : Left1 n := {}.
+Instance Top1ToRight1  (n : nat) `{Top1 n}   : Right1 n := {}.
+Instance Bot1ToTopSucc (n : nat) `{Bot1 n}   : Top1 (S n) := {}.
 
-(* (* Finished transaction in 1.389 secs (1.387u,0.s) (successful) *) *)
-(* Module Test225. Time Instance TtR225 : B unit 225 := _. End Test225. *)
+Class Top2 (n : nat) : Type.
+Class Bot2   (n : nat) : Type.
+Class Left2  (n : nat) : Type.
+Class Right2 (n : nat) : Type.
 
-(* (* Finished transaction in 12.928 secs (12.913u,0.011s) (successful) *) *)
-(* Module Test450. Time Instance TtR450 : B unit 450 := _. End Test450. *)
+Instance Left2ToBot2   (n : nat) `{Left2 n}  : Bot2 n := {}.
+Instance Right2ToBot2  (n : nat) `{Right2 n} : Bot2 n := {}.
+Instance Top2ToLeft2   (n : nat) `{Top2 n}   : Left2 n := {}.
+Instance Top2ToRight2  (n : nat) `{Top2 n}   : Right2 n := {}.
+Instance Bot2ToTopSucc (n : nat) `{Bot2 n}   : Top2 (S n) := {}.
 
-(* (* Finished transaction in 38.213 secs (38.175u,0.001s) (successful) *) *)
-(* Module Test675. Time Instance TtR675 : B unit 675 := _. End Test675. *)
+Class Top (n : nat) : Type.
 
-(* (* Finished transaction in 104.095 secs (103.999u,0.074s) (successful) *) *)
-(* Module Test900. Time Instance TtR900 : B unit 900 := _. End Test900. *)
+Instance Top1ToTop (n : nat) `{Top1 n} : Top n := {}.
+Instance Top2ToTop (n : nat) `{Top2 n} : Top n := {}.
 
-(* (* Finished transaction in 175.868 secs (175.7u,0.026s) (successful) *) *)
-(* Module Test1125. Time Instance TtR1125 : B unit 1125 := _. End Test1125. *)
+(* (* Finished transaction in 0.001 secs (0.001u,0.s) (successful) *) *)
+(* Module Top4Rocq. Time Instance Top4 : Top 4 := _. End Top4Rocq. *)
 
-(* (* Finished transaction in 355.404 secs (355.286u,0.021s) (successful) *) *)
-(* Module Test1350. Time Instance B1350 : B unit 1350 := _. End Test1350. *)
+(* (* Finished transaction in 0.021 secs (0.021u,0.s) (successful) *) *)
+(* Module Top8Rocq. Time Instance Top8 : Top 8 := _. End Top8Rocq. *)
 
-(* (* Finished transaction in 534.246 secs (533.92u,0.079s) (successful) *) *)
-(* Module Test1575. Time Instance TtR1575 : B unit 1575 := _. End Test1575. *)
+(* (* Finished transaction in 4.661 secs (4.661u,0.s) (successful) *) *)
+(* Module Top16Rocq. Time Instance Top16 : Top 16 := _. End Top16Rocq. *)
 
-(* (* Finished transaction in 849.83 secs (849.087u,0.431s) (successful) *) *)
-(* Module Test1800. Time Instance B1800 : B unit 1800 := _. End Test1800. *)
+(* (* Finished transaction in 0.719 secs (0.717u,0.s) (successful) *) *)
+(* Module Top17Rocq. Time Instance Top17 : Top 17 := _. End Top17Rocq. *)
 
-(* (* Finished transaction in 1098.921 secs (1098.166u,0.083s) (successful) *) *)
-(* Module Test2025. Time Instance TtR2025 : B unit 2025 := _. End Test2025. *)
+(* (* Finished transaction in 1.409 secs (1.407u,0.s) (successful) *) *)
+(* Module Top18Rocq. Time Instance Top18 : Top 18 := _. End Top18Rocq. *)
 
-(* (* Finished transaction in 1441.027 secs (1439.305u,0.752s) (successful) *) *)
-(* Module Test2250. Time Instance B2250 : B unit 2250 := _. End Test2250. *)
+(* (* Finished transaction in 2.789 secs (2.785u,0.002s) (successful) *) *)
+(* Module Top19Rocq. Time Instance Top19 : Top 19 := _. End Top19Rocq. *)
+
+(* (* Finished transaction in 5.602 secs (5.597u,0.001s) (successful) *) *)
+(* Module Top20Rocq. Time Instance Top20 : Top 20 := _. End Top20Rocq. *)
+
+(* (* Finished transaction in 170.346 secs (170.255u,0.004s) (successful) *) *)
+(* Module Top21Rocq. Time Instance Top21 : Top 21 := _. End Top21Rocq. *)
+
+(* (* Finished transaction in 351.702 secs (351.432u,0.033s) (successful) *) *)
+(* Module Top22Rocq. Time Instance Top22 : Top 22 := _. End Top22Rocq. *)
+
+(* (* Finished transaction in 699.508 secs (699.034u,0.059s) (successful) *) *)
+(* Module Top23Rocq. Time Instance Top23 : Top 23 := _. End Top23Rocq. *)
 
 From elpi Require Import elpi.
 From elpi.apps Require Import tc.
 
-(* Elpi TC Solver Activate TC.Solver. *)
+Elpi TC Solver Activate TC.Solver.
 Elpi TC Solver Override TC.Solver All.
 
 TC.AddAllClasses.
 TC.AddAllInstances.
 
-(* (* Finished transaction in 3.082 secs (3.052u,0.026s) (successful) *) *)
-(* (* Finished transaction in 5.362 secs (3.159u,0.319s) (successful) *) *)
-(* (* Finished transaction in 7.973 secs (3.183u,0.686s) (successful) *) *)
-(* Module Test700TC. Time Instance B700 : B unit 700 := _. End Test700TC. *)
+(* ELPI TC solver *)
+
+(* (* Finished transaction in 0.029 secs (0.029u,0.s) (successful) *) *)
+(* Module Top4ELPI_TC. Time Instance Top4 : Top 4 := _. End Top4ELPI_TC. *)
+
+(* (* Finished transaction in 0.035 secs (0.035u,0.s) (successful) *) *)
+(* Module Top8ELPI_TC. Time Instance Top8 : Top 8 := _. End Top8ELPI_TC. *)
+
+(* (* Finished transaction in 0.368 secs (0.367u,0.s) (successful) *) *)
+(* Module Top16ELPI_TC. Time Instance Top16 : Top 16 := _. End Top16ELPI_TC. *)
+
+(* (* Finished transaction in 0.719 secs (0.717u,0.s) (successful) *) *)
+(* Module Top17ELPI_TC. Time Instance Top17 : Top 17 := _. End Top17ELPI_TC. *)
+
+(* (* Finished transaction in 1.409 secs (1.407u,0.s) (successful) *) *)
+(* Module Top18ELPI_TC. Time Instance Top18 : Top 18 := _. End Top18ELPI_TC. *)
+
+(* (* Finished transaction in 2.789 secs (2.785u,0.002s) (successful) *) *)
+(* Module Top19ELPI_TC. Time Instance Top19 : Top 19 := _. End Top19ELPI_TC. *)
+
+(* (* Finished transaction in 5.602 secs (5.597u,0.001s) (successful) *) *)
+(* Module Top20ELPI_TC. Time Instance Top20 : Top 20 := _. End Top20ELPI_TC. *)
 
-(* (* Finished transaction in 13.83 secs (13.794u,0.003s) (successful) *) *)
-(* (* Finished transaction in 12.364 secs (12.353u,0.s) (successful) *) *)
-(* (* Finished transaction in 12.292 secs (12.195u,0.019s) (successful) *) *)
-(* Module Test1400TC. Time Instance B1400 : B unit 1400 := _. End Test1400TC. *)
+(* (* Finished transaction in 12.295 secs (12.281u,0.002s) (successful) *) *)
+(* Module Top21ELPI_TC. Time Instance Top21 : Top 21 := _. End Top21ELPI_TC. *)
 
-(* (* Finished transaction in 29.792 secs (28.346u,0.261s) (successful) *) *)
-(* (* Finished transaction in 29.792 secs (28.346u,0.261s) (successful) *) *)
-(* Module Test2100TC. Time Instance B2100 : B unit 2100 := _. End Test2100TC. *)
+(* (* Finished transaction in 27.964 secs (27.951u,0.003s) (successful) *) *)
+(* Module Top22ELPI_TC. Time Instance Top22 : Top 22 := _. End Top22ELPI_TC. *)
 
-(* (* Finished transaction in 56.321 secs (54.822u,1.44s) (successful) *) *)
-(* Module Test2800TC. Time Instance B2800 : B unit 2800 := _. End Test2800TC. *)
+(* (* Finished transaction in 49.262 secs (49.231u,0.008s) (successful) *) *)
+(* Module Top23ELPI_TC. Time Instance Top23 : Top 23 := _. End Top23ELPI_TC. *)
 
-(* (* Finished transaction in 84.556 secs (82.008u,2.295s) (successful) *) *)
-(* Module Test3500TC. Time Instance B3500 : B unit 3500 := _. End Test3500TC. *)
+(* (* Finished transaction in 101.836 secs (101.792u,0.017s) (successful) *) *)
+(* Module Top24ELPI_TC. Time Instance Top24 : Top 24 := _. End Top24ELPI_TC. *)
 
-(* (* Finished transaction in 132.134 secs (125.754u,3.332s) (successful) *) *)
-(* Module Test4200TC. Time Instance B4200 : B unit 4200 := _. End Test4200TC. *)
+(* (* Finished transaction in 205.469 secs (205.309u,0.032s) (successful) *) *)
+(* Module Top25ELPI_TC. Time Instance Top25 : Top 25 := _. End Top25ELPI_TC. *)
 
-(* Finished transaction in 198.935 secs (162.925u,7.034s) (successful) *)
-(* Module Test4900TC. Time Instance B4900 : B unit 4900 := _. End Test4900TC. *)
 
-(* (* Stack overflow *) *)
-(* (* Module Test5600TC. Time Instance B5600 : B unit 5600 := _. End Test5600TC. *) *)
+(* / ELPI TC solver *)
 
 Elpi TC Solver Override TC.Solver None.
 
@@ -92,35 +118,64 @@ From elpi.apps.tc_tabled Require Import tabled_type_class.
 Elpi TC Solver Activate TC.TabledSolver.
 Elpi TC Solver Override TC.TabledSolver All.
 
-(* Finished transaction in 1.911 secs (1.901u,0.007s) (successful) *)
-Module Test50Tabled. Time Instance B50 : B unit 50 := _. End Test50Tabled. (* Takes: 20000 - 19650 steps *)
+(* Tabled solver *)
+
+(* Finished transaction in 0.023 secs (0.023u,0.s) (successful) *)
+Module Top4Tabled. Time Instance Top4 : Top 4 := _. End Top4Tabled.
+
+(* Finished transaction in 0.054 secs (0.054u,0.s) (successful) *)
+Module Top8Tabled. Time Instance Top8 : Top 8 := _. End Top8Tabled.
+
+(* Finished transaction in 0.201 secs (0.197u,0.003s) (successful) *)
+Module Top16Tabled. Time Instance Top16 : Top 16 := _. End Top16Tabled.
+
+(* Finished transaction in 0.273 secs (0.267u,0.005s) (successful) *)
+Module Top17Tabled. Time Instance Top17 : Top 17 := _. End Top17Tabled.
+
+(* Finished transaction in 0.255 secs (0.253u,0.s) (successful) *)
+Module Top18Tabled. Time Instance Top18 : Top 18 := _. End Top18Tabled.
+
+(* Finished transaction in 0.289 secs (0.286u,0.001s) (successful) *)
+Module Top19Tabled. Time Instance Top19 : Top 19 := _. End Top19Tabled.
+
+(* Finished transaction in 0.369 secs (0.36u,0.007s) (successful) *)
+Module Top20Tabled. Time Instance Top20 : Top 20 := _. End Top20Tabled.
+
+(* Finished transaction in 0.363 secs (0.351u,0.011s) (successful) *)
+Module Top21Tabled. Time Instance Top21 : Top 21 := _. End Top21Tabled.
+
+(* Finished transaction in 0.372 secs (0.372u,0.s) (successful) *)
+Module Top22Tabled. Time Instance Top22 : Top 22 := _. End Top22Tabled.
+
+(* Finished transaction in 0.419 secs (0.415u,0.003s) (successful) *)
+Module Top23Tabled. Time Instance Top23 : Top 23 := _. End Top23Tabled.
 
-(* (* Finished transaction in 1.911 secs (1.901u,0.007s) (successful) *) *)
-(* Module Test50Tabled. Time Instance B50 : B unit 50 := _. End Test50Tabled. (* Takes: 20000 - 19650 steps *) *)
+(* Finished transaction in 0.507 secs (0.506u,0.s) (successful) *)
+Module Top24Tabled. Time Instance Top24 : Top 24 := _. End Top24Tabled.
 
-(* (* Finished transaction in 12.3 secs (12.253u,0.032s) (successful) *) *)
-(* Module Test100Tabled. Time Instance B100 : B unit 100 := _. End Test100Tabled. (* Takes: 20000 - 19300 steps *) *)
+(* Finished transaction in 0.525 secs (0.519u,0.005s) (successful) *)
+Module Top25Tabled. Time Instance Top25 : Top 25 := _. End Top25Tabled.
 
-(* (* Finished transaction in 50.408 secs (50.147u,0.152s) (successful) *) *)
-(* Module Test150Tabled. Time Instance B150 : B unit 150 := _. End Test150Tabled. (* Takes: 20000 - 18950 steps *) *)
+(* Finished transaction in 3.148 secs (3.147u,0.s) (successful) *)
+Module Top50Tabled. Time Instance Top50 : Top 50 := _. End Top50Tabled.
 
-(* (* Finished transaction in 154.541 secs (153.917u,0.547s) (successful) *) *)
-(* Module Test200Tabled. Time Instance B200 : B unit 200 := _. End Test200Tabled. (* Takes: 20000 - 18600 steps *) *)
+(* Finished transaction in 10.138 secs (10.041u,0.092s) (successful) *)
+Module Top75Tabled. Time Instance Top75 : Top 75 := _. End Top75Tabled.
 
-(* (* Finished transaction in 435.689 secs (434.456u,0.983s) (successful) *) *)
-(* Module Test250Tabled. Time Instance B250 : B unit 250 := _. End Test250Tabled. (* Takes: 20000 - 18250 steps *) *)
+(* Finished transaction in 26.328 secs (26.289u,0.006s) (successful) *)
+Module Top100Tabled. Time Instance Top100 : Top 100 := _. End Top100Tabled.
 
-(* (* Finished transaction in 694.726 secs (693.17u,1.298s) (successful) *) *)
-(* Module Test300Tabled. Time Instance B300 : B unit 300 := _. End Test300Tabled. (* Takes: 20000 - 17900 steps *) *)
+(* Finished transaction in 48.959 secs (48.772u,0.174s) (successful) *)
+Module Top125Tabled. Time Instance Top125 : Top 125 := _. End Top125Tabled.
 
-(* (* Finished transaction in 1473.093 secs (1437.954u,6.426s) (successful) *) *)
-(* Module Test350Tabled. Time Instance B350 : B unit 350 := _. End Test350Tabled. (* Takes: 20000 - 17550 steps *) *)
+(* Finished transaction in 87.289 secs (87.152u,0.13s) (successful) *)
+Module Top150Tabled. Time Instance Top150 : Top 150 := _. End Top150Tabled.
 
-(* (* Finished transaction in 2457.3 secs (2447.5u,3.536s) (successful) *) *)
-(* Module Test400Tabled. Time Instance B400 : B unit 400 := _. End Test400Tabled. (* Takes: 20000 - 17200 steps *) *)
+(* Finished transaction in 152.848 secs (152.537u,0.223s) (successful) *)
+Module Top175Tabled. Time Instance Top175 : Top 175 := _. End Top175Tabled.
 
-(* (* Finished transaction in 3465.9 secs (3306.596u,16.99s) (successful) *) *)
-(* Module Test450Tabled. Time Instance B450 : B unit 450 := _. End Test450Tabled. (* Takes: 20000 - 16850 steps *) *)
+(* Finished transaction in 247.147 secs (246.117u,0.948s) (successful) *)
+Module Top200Tabled. Time Instance Top200 : Top 200 := _. End Top200Tabled.
 
-(* (* Finished transaction in 4962.323 secs (4843.782u,17.345s) (successful) *) *)
-(* Module Test500Tabled. Time Instance B500 : B unit 500 := _. End Test500Tabled. (* Takes: 20000 - 16500 steps *) *)
+(* / Tabled solver *)
+(* Finished transaction in 726.238 secs (725.633u,0.254s) (successful) *)