diff --git a/.gitmodules b/.gitmodules
index 5defec0..e69de29 100644
--- a/.gitmodules
+++ b/.gitmodules
@@ -1,9 +0,0 @@
-[submodule "external/stdpp"]
-	path = external/stdpp
-	url = https://gitlab.mpi-sws.org/iris/stdpp.git
-[submodule "external/iris"]
-	path = external/iris
-	url = https://gitlab.mpi-sws.org/iris/iris.git
-[submodule "external/paco"]
-	path = external/paco
-	url = https://github.com/snu-sf/paco.git
diff --git a/Makefile b/Makefile
index a0f3c39..b05bc18 100644
--- a/Makefile
+++ b/Makefile
@@ -1,10 +1,10 @@
 TRILLIUM_DIR := 'trillium'
+HL_DIR := 'heap_lang'
+FAIRNESS_DIR := 'fairness'
 FAIRIS_DIR := 'fairis'
-LOCAL_SRC_DIRS := $(TRILLIUM_DIR) $(FAIRIS_DIR)
-SRC_DIRS := $(LOCAL_SRC_DIRS) 'external'
+SRC_DIRS := $(TRILLIUM_DIR) $(FAIRNESS_DIR) $(HL_DIR) $(FAIRIS_DIR)
 
-ALL_VFILES := $(shell find $(SRC_DIRS) -name "*.v")
-VFILES := $(shell find $(LOCAL_SRC_DIRS) -name "*.v")
+VFILES := $(shell find $(SRC_DIRS) -name "*.v")
 
 COQC := coqc
 Q:=@
@@ -14,9 +14,9 @@ COQPROJECT_ARGS := $(shell sed -E -e '/^\#/d' -e 's/-arg ([^ ]*)/\1/g' _CoqProje
 
 all: $(VFILES:.v=.vo)
 
-.coqdeps.d: $(ALL_VFILES) _CoqProject
+.coqdeps.d: $(VFILES) _CoqProject
 	@echo "COQDEP $@"
-	$(Q)coqdep -vos -f _CoqProject $(ALL_VFILES) > $@
+	$(Q)coqdep -vos -f _CoqProject $(VFILES) > $@
 
 # do not try to build dependencies if cleaning or just building _CoqProject
 ifeq ($(filter clean,$(MAKECMDGOALS)),)
@@ -43,26 +43,33 @@ clean:
 	rm -f .coqdeps.d
 
 # project-specific targets
-.PHONY: build clean-trillium clean-fairis trillium fairis
+.PHONY: build clean-trillium trillium clean-fairness fairness clean-heap-lang heap-lang clean-fairis fairis
 
-VPATH= $(TRILLIUM_DIR) $(FAIRIS_DIR)
+VPATH= $(TRILLIUM_DIR) $(FAIRNESS_DIR) $(HL_DIR) $(FAIRIS_DIR)
 VPATH_FILES := $(shell find $(VPATH) -name "*.v")
 
 build: $(VPATH_FILES:.v=.vo)
 
-fairis :
-	@$(MAKE) build VPATH=$(FAIRIS_DIR)
-
 trillium :
 	@$(MAKE) build VPATH=$(TRILLIUM_DIR)
 
-clean-local:
-	@echo "CLEAN vo glob aux"
-	$(Q)find $(LOCAL_SRC_DIRS) \( -name "*.vo" -o -name "*.vo[sk]" \
-		-o -name ".*.aux" -o -name ".*.cache" -o -name "*.glob" \) -delete
+fairness :
+	@$(MAKE) build VPATH=$(FAIRNESS_DIR)
+
+heap-lang :
+	@$(MAKE) build VPATH=$(HL_DIR)
+
+fairis :
+	@$(MAKE) build VPATH=$(FAIRIS_DIR)
 
 clean-trillium:
-	@$(MAKE) clean-local LOCAL_SRC_DIRS=$(TRILLIUM_DIR)
+	@$(MAKE) clean SRC_DIRS=$(TRILLIUM_DIR)
+
+clean-fairness:
+	@$(MAKE) clean SRC_DIRS=$(FAIRNESS_DIR)
+
+clean-heap-lang:
+	@$(MAKE) clean SRC_DIRS=$(HL_DIR)
 
 clean-fairis:
-	@$(MAKE) clean-local LOCAL_SRC_DIRS=$(FAIRIS_DIR)
+	@$(MAKE) clean SRC_DIRS=$(FAIRIS_DIR)
diff --git a/README.md b/README.md
index 19635ca..1afd37e 100644
--- a/README.md
+++ b/README.md
@@ -3,65 +3,69 @@
 Trillium is a higher-order concurrent separation logic for proving trace
 refinements between programs and models. The logic is
 built using the [Iris](https://iris-project.org) program logic framework and
-mechanized in the [Coq proof assistant](https://coq.inria.fr/).
+mechanized in the [Rocq proof assistant](https://rocq-prover.org/).
 
 ## Directory Structure
 
 - [`trillium/`](trillium/): The Trillium program logic framework
 
-- [`fairis/`](fairis/): The Fairis instantiation of Trillium for reasoning
-  about fair termination of concurrent programs.
-  + [`heap_lang/`](fairis/heap_lang/): HeapLang instantiation with fuel model
-    * [`examples/`](fairis/heap_lang/examples/): Examples and case studies
+- [`heap_lang/`](heap_lang/) - a variation of HeapLang language (most notably - enriched with locales)
 
-- [`external/`](external/): External dependencies
+- [`fairness/`](fairness/) - a number of various trace and model utilities; most notably - a uniform definition of trace and model fairness.
 
-## Compiling
-
-The project maintains compatibility with Coq 8.17 and relies on `coqc` being
-available in your shell. Clone the external git submodule dependencies using
-
-    git submodule update --init --recursive
-
-Alternatively, clone the repository using the `--recurse-submodules` flag.
-
-Run `make -jN` to build the full development, where `N` is the number of your
-CPU cores.
-
-Note that the compilation of the external dependencies is known to print
-a lot of warning messages when compiled with Coq 8.17.
+- [`fairis/`](fairis/) - The Fairis program logic - an instantiation of Trillium for reasoning about fair termination of HeapLang programs.
 
-## Git submodule dependencies
 
-This project uses git submodules to manage dependencies with other Coq
-libraries. By default, when working with a repository that uses submodules, the
-submodules will *not* be populated and updated automatically, and it is often
-necessary to invoke `git submodule update --init --recursive` or use the
-`--recurse-submodules` flag. However, this can be automated by setting the
-`submodule.recurse` setting to `true` in your git config by running
-
-    git config --global submodule.recurse true
-
-This will make `git clone`, `git checkout`, `git pull`, etc. work as you would
-expect and it should rarely be necessary to invoke any `git submodule update`
-commands.
-
-A git submodule is pinned to a particular commit of an external (remote)
-repository. If new commits have been pushed to the remote repository and you
-wish to integrate these in to the development, invoke
-
-    git submodule update --remote
-
-to fetch the new commits and apply them to your local repository. This changes
-which commit your *local* submodule is pinned to. Remember to commit and push
-the submodule update to make it visible to other users of the repository.
+## Compiling
 
-Read more about git submodules in [this
-tutorial](https://git-scm.com/book/en/v2/Git-Tools-Submodules).
+    # create a new opam environment
+    opam switch create trillium_env 5.2.0
+    # switch into the new environment
+    eval $(opam env --switch=trillium_env)
+	
+    # set up repository for Rocq packages
+    opam repo add rocq-released https://rocq-prover.github.io/opam/released/
+
+    # install all dependencies of Trillium
+    opam install . --deps-only
+    # build Trillium; adjust the number of jobs as needed
+    make -j 5
+
+## Using Trillium in your project
+
+The instruction below applies until Trillium is released as a publicly available opam package.
+
+Your project should be set up as an opam package. 
+With that, add the Trillium dependency to its `.opam` file:
+
+    depends: [
+      # ...
+      "trillium" { (= "2.2.0") }
+    ]
+
+Then, clone the Trillium repo at some local path TRILLIUM_PATH.
+After that, execute the following in the root of your project:
+    
+    # create a new opam environment for your project
+    opam switch create project-env 5.2.0
+    # switch into the new environment
+    eval $(opam env --switch=project-env)
+	
+    # set up repository for Rocq packages
+    opam repo add rocq-released https://rocq-prover.github.io/opam/released/
+    # set up the local repository for Trillium
+    opam pin add trillium TRILLIUM_PATH --no-action
+
+    # install all dependencies of your project; Trillium will be installed as a part of it
+    opam install . --deps-only
+    # build your project
+    make -j 5	
+	
 
 ## Publications
 
-A [preprint](https://iris-project.org/pdfs/2021-submitted-trillium.pdf) is
-available describing Trillium, a program logic framework for both proving
-partial correctness properties and trace properties; Aneris is now an
-instantiation of the Trillium framework.
+- Trillium: Higher-Order Concurrent and Distributed Separation Logic for Intensional Refinement.
+ 
+  Amin Timany, Simon Oddershede Gregersen, Léo Stefanesco, Jonas Kastberg Hinrichsen, Léon Gondelman, Abel Nieto, Lars Birkedal.
+  
+  In POPL 2024: ACM SIGPLAN Symposium on Principles of Programming Languages
diff --git a/_CoqProject b/_CoqProject
index 03cc163..344f20d 100644
--- a/_CoqProject
+++ b/_CoqProject
@@ -1,13 +1,7 @@
 -Q trillium trillium
--Q fairis trillium.fairness
-
--Q external/stdpp/stdpp stdpp
--Q external/stdpp/stdpp_unstable stdpp.unstable
--Q external/iris/iris iris
--Q external/iris/iris_deprecated iris.deprecated
--Q external/iris/iris_unstable iris.unstable
--Q external/iris/iris_heap_lang iris.heap_lang
--Q external/paco/src Paco
+-Q heap_lang heap_lang
+-Q fairness fairness
+-Q fairis fairis
 
 -arg -w -arg -notation-overridden
 -arg -w -arg -redundant-canonical-projection
diff --git a/external/iris b/external/iris
deleted file mode 160000
index 1bba489..0000000
--- a/external/iris
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 1bba4893b4d34539f6751ad50f1ec9ea8cefbdc3
diff --git a/external/paco b/external/paco
deleted file mode 160000
index 5c5693f..0000000
--- a/external/paco
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 5c5693f46c8957f36a2349a0d906e911366136de
diff --git a/external/stdpp b/external/stdpp
deleted file mode 160000
index bc24e51..0000000
--- a/external/stdpp
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit bc24e51ca9ef6eb06af8731f97680725b2f0fb32
diff --git a/fairis/heap_lang/adequacy.v b/fairis/adequacy.v
similarity index 81%
rename from fairis/heap_lang/adequacy.v
rename to fairis/adequacy.v
index 43ee2a7..ebae0d3 100644
--- a/fairis/heap_lang/adequacy.v
+++ b/fairis/adequacy.v
@@ -4,94 +4,15 @@ From iris.algebra Require Import auth gmap gset excl.
 From iris.base_logic Require Export gen_heap.
 From trillium.prelude Require Import classical_instances.
 From trillium.program_logic Require Import weakestpre adequacy.
-From trillium.fairness Require Export fairness fair_termination fairness_finiteness fuel fuel_termination map_included_utils resources.
+From fairness Require Export fairness.
+From fairis Require Import fair_termination fairness_finiteness fuel fuel_termination map_included_utils resources heap_lang_lm destuttering.
 From trillium.program_logic Require Import ectx_lifting.
-From trillium.fairness.heap_lang Require Import lang.
-From trillium.fairness.heap_lang Require Import tactics notation.
-From trillium.fairness.heap_lang Require Import lifting.
-Set Default Proof Using "Type".
-
-Section adequacy.
-
-Lemma posts_of_empty_mapping `{heapGS Σ M} (e1 e: expr) v (tid : nat) (tp : list expr):
-  tp !! tid = Some e ->
-  to_val e = Some v ->
-  posts_of tp ((λ (_ : val), 0%nat ↦M ∅) ::  (map (λ '(tnew, e), fork_post (locale_of tnew e)) (prefixes_from [e1] (drop (length [e1]) tp)))) -∗
-  tid ↦M ∅.
-Proof.
-  intros Hsome Hval. simpl.
-  rewrite (big_sepL_elem_of (λ x, x.2 x.1) _ (v, (λ _: val, tid ↦M ∅)%I) _);
-    first by auto.
-  apply elem_of_list_omap.
-  exists (e, (λ _: val, tid ↦M ∅)%I); split; last first.
-  - simpl. apply fmap_Some. exists v. split; done.
-  - destruct tp as [|e1' tp]; first set_solver. simpl.
-    apply elem_of_cons.
-    destruct tid as [|tid]; [left|right]; first by simpl in Hsome; simplify_eq.
-    apply elem_of_lookup_zip_with. eexists tid, e, _. do 2 split =>//.
-    rewrite /locale_of /=.
-    rewrite list_lookup_fmap fmap_Some. simpl in Hsome.
-    exists (e1 :: take tid tp, e). rewrite drop_0. split.
-    + erewrite prefixes_from_lookup =>//.
-    + rewrite /locale_of /= take_length_le //.
-      assert (tid < length tp)%nat; last lia. by eapply lookup_lt_Some.
-Qed.
-
-Lemma from_locale_from_lookup tp0 tp tid e :
-  from_locale_from tp0 tp tid = Some e <-> (tp !! (tid - length tp0)%nat = Some e ∧ (length tp0 <= tid)%nat).
-Proof.
-  split.
-  - revert tp0 tid. induction tp as [| e1 tp1 IH]; intros tp0 tid.
-    { unfold from_locale. simpl. done. }
-    unfold from_locale. simpl.
-    destruct (decide (locale_of tp0 e1 = tid)).
-    + intros ?; simplify_eq. rewrite /locale_of /= Nat.sub_diag.
-      split; [done|lia].
-    + intros [H Hlen]%IH. rewrite app_length /= in H.
-      rewrite app_length /= in Hlen.
-      destruct tid as [|tid]; first lia.
-      assert (Heq1 : (length tp0 + 1 = S (length tp0))%nat) by lia.
-      rewrite Heq1 in Hlen.
-      assert (length tp0 ≤ tid)%nat by lia.
-      assert (Heq : (S tid - length tp0)%nat = (S ((tid - (length tp0))))%nat) by lia.
-      rewrite Heq /=. split.
-      * rewrite -H. f_equal. lia.
-      * transitivity tid; try lia. assumption.
-  - revert tp0 tid. induction tp as [|e1 tp1 IH]; intros tp0 tid.
-    { set_solver. }
-    destruct (decide (tid = length tp0)) as [-> | Hneq].
-    + rewrite Nat.sub_diag /=. intros  [? _]. simplify_eq.
-      rewrite decide_True //.
-    + intros [Hlk Hlen]. assert (length tp0 < tid)%nat as Hle by lia.
-      simpl. rewrite decide_False //. apply IH. split.
-      * assert (tid - length tp0 = S ((tid - 1) - length tp0))%nat as Heq by lia.
-        rewrite Heq /= in Hlk. rewrite -Hlk app_length /=. f_equal; lia.
-      * rewrite app_length /=. apply Nat.le_succ_l in Hle. rewrite Nat.add_comm //.
-Qed.
-
-Lemma from_locale_lookup tp tid e :
-  from_locale tp tid = Some e <-> tp !! tid = Some e.
-Proof.
-  assert (from_locale tp tid = Some e <-> (tp !! tid = Some e ∧ 0 ≤ tid)%nat) as H; last first.
-  { split; intros ?; apply H; eauto. split; [done|lia]. }
-  unfold from_locale. replace (tid) with (tid - length (A := expr) [])%nat at 2;
-    first apply from_locale_from_lookup. simpl; lia.
-Qed.
+From heap_lang Require Import locales_helpers_hl.
 
-Definition indexes {A} (xs : list A) := imap (λ i _, i) xs.
 
-Lemma locales_of_list_from_indexes (es' es : list expr) :
-  locales_of_list_from es' es = imap (λ i _, length es' + i)%nat es.
-Proof.
-  revert es'. induction es; [done|]; intros es'.
-  rewrite locales_of_list_from_cons=> /=. rewrite /locale_of.
-  f_equiv; [lia|]. rewrite IHes. apply imap_ext.
-  intros x ? Hin. rewrite app_length=> /=. lia.
-Qed.
+Set Default Proof Using "Type".
 
-Lemma locales_of_list_indexes (es : list expr) :
-  locales_of_list es = indexes es.
-Proof. apply locales_of_list_from_indexes. Qed.
+Section adequacy.
 
 Theorem heap_lang_continued_simulation_fair_termination {FM : FairModel}
         `{FairTerminatingModel FM} {LM:LiveModel heap_lang FM} ξ a1 r1 extr :
@@ -131,13 +52,14 @@ Proof.
   iMod (model_state_init s1) as (γmod) "[Hmoda Hmodf]".
   iMod (model_fuel_mapping_init s1) as (γmap) "[Hmapa Hmapf]".
   iMod (model_free_roles_init s1 (FR ∖ live_roles _ s1)) as (γfr) "[HFR Hfr]".
+  set (hG := {| heap1_gen_heapGS := genheap |}). 
   set (distG :=
          {|
           heap_fairnessGS := {|
                               fairness_model_name := γmod;
                               fairness_model_fuel_mapping_name := γmap;
                               fairness_model_free_roles_name := γfr;
-                              |}
+                              |};
          |}).
   iMod (H distG) as "Hwp". clear H.
   iExists state_interp, (λ _, 0%nat ↦M ∅)%I, fork_post.
diff --git a/fairis/destuttering.v b/fairis/destuttering.v
new file mode 100644
index 0000000..60f65bb
--- /dev/null
+++ b/fairis/destuttering.v
@@ -0,0 +1,340 @@
+From fairness Require Import inftraces trace_lookup trace_len.
+From Paco Require Import paco1 paco2 pacotac.
+From iris.proofmode Require Import tactics.
+
+
+
+Section dec_unless.
+  Context {St S' L L': Type}.
+  Context (Us: St -> S').
+  Context (Ul: L -> option L').
+
+  Definition dec_unless Ψ (tr: trace St L) :=
+    ∀ n, match after n tr with
+         | Some ⟨ _ ⟩ | None => True
+         | Some (s -[ℓ]-> tr') =>
+           (∃ ℓ', Ul ℓ = Some ℓ') ∨
+           (Ψ (trfirst tr') < Ψ s ∧ Us s = Us (trfirst tr'))
+         end.
+
+  Lemma dec_unless_next Ψ s ℓ tr (Hdec: dec_unless Ψ (s -[ℓ]-> tr)): dec_unless Ψ tr.
+  Proof.
+    intros n. specialize (Hdec (n+1)). rewrite (after_sum 1) // in Hdec.
+  Qed.
+
+End dec_unless.
+
+
+Section destuttering.
+  Context {St S' L L': Type}.
+  Context (Us: St -> S').
+  Context (Ul: L -> option L').
+
+  Inductive upto_stutter_ind (upto_stutter_coind: trace St L -> trace S' L' -> Prop):
+    trace St L -> trace S' L' -> Prop :=
+  | upto_stutter_singleton s:
+      upto_stutter_ind upto_stutter_coind ⟨s⟩ ⟨Us s⟩
+  | upto_stutter_stutter btr str s ℓ:
+      Ul ℓ = None ->
+      (* (Us s = Us (trfirst btr) -> (or something like this...?) *)
+      Us s = Us (trfirst btr) ->
+      Us s = trfirst str ->
+      upto_stutter_ind upto_stutter_coind btr str ->
+      upto_stutter_ind upto_stutter_coind (s -[ℓ]-> btr) str
+  | upto_stutter_step btr str s ℓ s' ℓ':
+      Us s = s' ->
+      Ul ℓ = Some ℓ' ->
+      upto_stutter_coind btr str ->
+      upto_stutter_ind upto_stutter_coind (s -[ℓ]-> btr) (s' -[ℓ']-> str).
+
+  Definition upto_stutter := paco2 upto_stutter_ind bot2.
+
+  Lemma upto_stutter_mono :
+    monotone2 (upto_stutter_ind).
+  Proof.
+    unfold monotone2. intros x0 x1 r r' IN LE.
+    induction IN; try (econstructor; eauto; done).
+  Qed.
+  Hint Resolve upto_stutter_mono : paco.
+
+  Lemma upto_stutter_after {btr str} n {str'}:
+    upto_stutter btr str ->
+    after n str = Some str' ->
+    ∃ n' btr', after n' btr = Some btr' ∧ upto_stutter btr' str'.
+  Proof.
+    assert (Hw: ∀ (P: nat -> Prop), (∃ n, P (S n)) -> (∃ n, P n)).
+    { intros P [x ?]. by exists (S x). }
+    revert btr str str'. induction n as [|n IH]; intros btr str str' Hupto Hafter.
+    { injection Hafter => <-. clear Hafter. exists 0, btr. done. }
+    revert str' Hafter. punfold Hupto. induction Hupto as
+        [s|btr str s ℓ HUl HUs1 HUs2 Hind IHH|btr str s ℓ s' ℓ' ?? Hind].
+    - intros str' Hafter. done.
+    - intros str' Hafter.
+      apply Hw. simpl. by apply IHH.
+    - intros str' Hafter. simpl in Hafter.
+      apply Hw. simpl. eapply IH; eauto. 
+      by destruct Hind.
+  Qed.
+
+  Local Ltac gd t := generalize dependent t.
+
+  Lemma upto_stutter_after'
+    {btr : trace St L} {str : trace S' L'} (n : nat) {btr' : trace St L}:
+    upto_stutter btr str
+    → after n btr = Some btr'
+      → ∃ (n' : nat) (str' : trace S' L'),
+          after n' str = Some str' ∧ upto_stutter btr' str'.
+  Proof.
+    have Hw: ∀ (P: nat -> Prop), (∃ n, P (S n)) -> (∃ n, P n).
+    { intros P [x ?]. by exists (S x). }
+
+    intros. 
+    gd btr. gd str. gd btr'. induction n as [|n IH]; intros btr' str btr Hupto Hafter.
+    { injection Hafter => <-. clear Hafter. exists 0, str. done. }
+    punfold Hupto.
+    inversion Hupto; subst. 
+    - done.
+    - simpl in Hafter. rename btr0 into btr. 
+      specialize (IH btr' str btr).
+      eapply IH; eauto. 
+      by pfold.
+    - simpl in Hafter. rename btr0 into btr. rename str0 into str.
+      specialize (IH btr' str btr).
+      assert (upto_stutter btr str) as UPTO'.
+      { inversion H1; eauto. done. }
+      specialize (IH UPTO' Hafter) as (?&?&?&?). 
+      eauto. 
+  Qed. 
+
+  Lemma upto_stutter_after_None {btr str} n:
+    upto_stutter btr str ->
+    after n str = None ->
+    ∃ n', after n' btr = None.
+  Proof.
+    assert (Hw: ∀ (P: nat -> Prop), (∃ n, P (S n)) -> (∃ n, P n)).
+    { intros P [x ?]. by exists (S x). }
+    revert btr str. induction n as [|n IH]; intros btr str Hupto Hafter.
+    { exists 0. done. }
+    revert Hafter. punfold Hupto. induction Hupto as
+        [s|btr str s ℓ HUl HUs1 HUs2 Hind IHH|btr str s ℓ s' ℓ' ?? Hind].
+    - intros Hafter. by exists 1.
+    - intros Hafter.
+      apply Hw. simpl. by apply IHH.
+    - intros Hafter. simpl in Hafter.
+      apply Hw. simpl. eapply IH; eauto.
+      by destruct Hind.
+  Qed.
+
+  Lemma upto_stutter_infinite_trace tr1 tr2 :
+    upto_stutter tr1 tr2 → infinite_trace tr1 → infinite_trace tr2.
+  Proof.
+    intros Hstutter Hinf n.
+    revert tr1 tr2 Hstutter Hinf.
+    induction n as [|n IHn]; intros tr1 tr2 Hstutter Hinf.
+    - punfold Hstutter.
+    - punfold Hstutter.
+      induction Hstutter.
+      + specialize (Hinf (1 + n)).
+        rewrite after_sum' in Hinf. simpl in *. apply is_Some_None in Hinf. done.
+      + apply IHHstutter.
+        intros m. specialize (Hinf (1 + m)).
+        rewrite after_sum' in Hinf. simpl in *. done.
+      + simpl. eapply (IHn btr str); [by destruct H1|].
+        intros m. specialize (Hinf (1 + m)).
+        rewrite after_sum' in Hinf. simpl in *. done.
+  Qed.
+
+  Lemma upto_stutter_trfirst btr str
+    (CORR: upto_stutter btr str):
+    trfirst str = Us (trfirst btr). 
+  Proof.
+    punfold CORR. by inversion CORR.
+  Qed. 
+
+  Program Fixpoint destutter_once_step N Ψ (btr: trace St L) :
+    Ψ (trfirst btr) < N →
+    dec_unless Us Ul Ψ btr →
+    S' + (S' * L' * { btr' : trace St L | dec_unless Us Ul Ψ btr'}) :=
+    match N as n return
+          Ψ (trfirst btr) < n →
+          dec_unless Us Ul Ψ btr →
+          S' + (S' * L' * { btr' : trace St L | dec_unless Us Ul Ψ btr'})
+    with
+    | O => λ Hlt _, False_rect _ (Nat.nlt_0_r _ Hlt)
+    | S N' =>
+      λ Hlt Hdec,
+      match btr as z return btr = z → S' + (S' * L' * { btr' : trace St L | dec_unless Us Ul Ψ btr'}) with
+      | tr_singl s => λ _, inl (Us s)
+      | tr_cons s l btr' =>
+        λ Hbtreq,
+        match Ul l as z return Ul l = z → S' + (S' * L' * { btr' : trace St L | dec_unless Us Ul Ψ btr'}) with
+        | Some l' => λ _, inr (Us s, l', exist _ btr' _)
+        | None => λ HUll, destutter_once_step N' Ψ btr' _ _
+        end eq_refl
+      end eq_refl
+    end.
+  Next Obligation.
+  Proof.
+    intros _ Ψ btr N' Hlt Hdec s l btr' -> l' HUll; simpl.
+    eapply dec_unless_next; done.
+  Qed.
+  Next Obligation.
+  Proof.
+    intros _ Ψ btr N' Hlt Hdec s l btr' -> HUll; simpl in *.
+    pose proof (Hdec 0) as [[? ?]|[? ?]]; [congruence|lia].
+  Qed.
+  Next Obligation.
+  Proof.
+    intros _ Ψ btr N' Hlt Hdec s l btr' -> HUll; simpl.
+    eapply dec_unless_next; done.
+  Qed.
+
+  CoFixpoint destutter_gen Ψ N (btr: trace St L) :
+    Ψ (trfirst btr) < N ->
+    dec_unless Us Ul Ψ btr → trace S' L' :=
+    λ Hlt Hdec,
+    match destutter_once_step N Ψ btr Hlt Hdec with
+    | inl s' => tr_singl s'
+    | inr (s', l', z) => tr_cons s' l' (destutter_gen Ψ  (S (Ψ (trfirst $ proj1_sig z)))
+                                                 (proj1_sig z) (Nat.lt_succ_diag_r _) (proj2_sig z))
+    end.
+
+  Definition destutter Ψ (btr: trace St L) :
+    dec_unless Us Ul Ψ btr → trace S' L' :=
+    λ Hdec,
+    destutter_gen Ψ (S (Ψ (trfirst btr))) btr (Nat.lt_succ_diag_r _) Hdec.
+
+  Lemma destutter_same_Us N Ψ btr Hlt Hdec:
+    match destutter_once_step N Ψ btr Hlt Hdec with
+    | inl s' | inr (s', _, _) => Us (trfirst btr) = s'
+    end.
+  Proof.
+    revert btr Hlt Hdec. induction N as [|N]; first lia.
+    intros btr Hlt Hdec. simpl.
+    destruct btr as [s|s ℓ btr']; first done.
+    generalize (destutter_once_step_obligation_1 Ψ (s -[ ℓ ]-> btr') N
+                Hlt Hdec s ℓ btr' eq_refl).
+    generalize (destutter_once_step_obligation_2 Ψ (s -[ ℓ ]-> btr') N Hlt Hdec s ℓ btr' eq_refl).
+    generalize (destutter_once_step_obligation_3 Ψ (s -[ ℓ ]-> btr') N Hlt Hdec s ℓ btr' eq_refl).
+    intros HunlessNone HltNone HdecSome.
+    destruct (Ul ℓ) as [ℓ'|] eqn:Heq; cbn; first done.
+    unfold dec_unless in Hdec.
+    destruct (Hdec 0) as [[??]|[? Hsame]]; first congruence.
+    rewrite Hsame. apply IHN.
+  Qed.
+
+  Lemma destutter_spec_ind N Ψ (btr: trace St L) (Hdec: dec_unless Us Ul Ψ btr)
+    (Hlt: Ψ (trfirst btr) < N):
+    upto_stutter btr (destutter_gen Ψ N btr Hlt Hdec).
+  Proof.
+    revert N btr Hlt Hdec.
+    pcofix CH. pfold.
+    induction N.
+    { intros; lia. }
+    intros btr Hlt Hdec.
+    rewrite (trace_unfold_fold (destutter_gen _ _ _ _ _)).
+    destruct btr as [s|s ℓ btr'].
+    { simpl in *. econstructor. }
+    cbn.
+    generalize (destutter_once_step_obligation_1 Ψ (s -[ ℓ ]-> btr') N
+                Hlt Hdec s ℓ btr' eq_refl).
+    generalize (destutter_once_step_obligation_2 Ψ (s -[ ℓ ]-> btr') N Hlt Hdec s ℓ btr' eq_refl).
+    generalize (destutter_once_step_obligation_3 Ψ (s -[ ℓ ]-> btr') N Hlt Hdec s ℓ btr' eq_refl).
+    intros HunlessNone HltNone HdecSome.
+    destruct (Ul ℓ) as [ℓ'|] eqn:Heq; cbn.
+    - econstructor 3 =>//. right. apply (CH (S (Ψ $ trfirst btr'))).
+    - econstructor 2=>//.
+      + destruct (Hdec 0) as [[??]|[??]];congruence.
+      + have ?: Us s = Us (trfirst btr').
+        { destruct (Hdec 0) as [[??]|[? Hsame]]; congruence. }
+        have HH := destutter_same_Us N Ψ btr' (HltNone eq_refl) (HunlessNone eq_refl).
+        destruct (destutter_once_step N Ψ btr' (HltNone eq_refl) (HunlessNone eq_refl)) as
+            [|[[??][??]]]eqn:Heq'; simpl in *; congruence.
+      + rewrite -trace_unfold_fold.
+        specialize (IHN btr' (HltNone eq_refl) (HunlessNone eq_refl)).
+        match goal with
+          [H : context[upto_stutter_ind]  |- ?Y] => let X := type of H in
+                          suffices <-: X <-> Y; first done
+        end.
+        f_equiv.
+        rewrite {1}(trace_unfold_fold (destutter_gen _ _ _ _ _)) /= -trace_unfold_fold //.
+  Qed.
+
+  Lemma destutter_spec Ψ (btr: trace St L) (Hdec: dec_unless Us Ul Ψ btr):
+    upto_stutter btr (destutter Ψ btr Hdec).
+  Proof. eapply destutter_spec_ind. Qed.
+
+  Lemma can_destutter Ψ (btr: trace St L) (Hdec: dec_unless Us Ul Ψ btr):
+    ∃ str, upto_stutter btr str.
+  Proof. exists (destutter Ψ btr Hdec). apply destutter_spec. Qed.
+
+End destuttering.
+
+
+Section Lookup.
+  Context {St S' L L' : Type}.
+  Context {Us : St → S'}.
+  Context (Ul: L -> option L').
+
+  Lemma upto_stutter_trace_label_lookup {btr : trace St L} {str : trace S' L'} 
+    (n : nat) st ℓ st' l:
+    upto_stutter Us Ul btr str →
+    btr !! n = Some (st, Some (ℓ, st')) ->
+    Ul ℓ = Some l ->
+    ∃ (n' : nat), str L!! n' = Some l.
+  Proof.
+    intros UPTO NTH MATCH.
+    pose proof (trace_has_len btr) as [? LEN].
+    apply trace_lookup_after_strong in NTH as (atr' & AFTER & A0). 
+    ogeneralize * (upto_stutter_after' _ _ n UPTO); eauto.
+    intros (n' & str' & AFTER' & UPTOn).
+    exists n'.
+    rewrite -(Nat.add_0_r n'). erewrite <- label_lookup_after; eauto.
+    punfold UPTOn; [| by apply upto_stutter_mono].
+    inversion UPTOn; subst; try congruence.
+    rewrite label_lookup_0. congruence.  
+  Qed.
+
+  Lemma upto_stutter_state_lookup {btr : trace St L} {str : trace S' L'} n' st':
+    upto_stutter Us Ul btr str
+    → str S!! n' = Some st' ->
+      ∃ n st, btr S!! n = Some st /\ Us st = st'.
+  Proof.
+    intros UPTO NTH.
+    pose proof (trace_has_len str) as [? LEN]. 
+    pose proof (proj1 (state_lookup_dom _ _ LEN n') (mk_is_Some _ _ NTH)) as BOUND.
+    pose proof (proj2 (LEN _) BOUND) as [str_n AFTER].
+    ogeneralize * (upto_stutter_after _ _ n' UPTO); eauto.
+    intros (n & btr' & AFTER' & UPTOn).
+    exists n.
+    rewrite -(Nat.add_0_r n). erewrite <- state_lookup_after; eauto.
+    rewrite state_lookup_0. f_equal.
+    eexists. split; [reflexivity| ].
+    etransitivity.
+    { symmetry. eapply upto_stutter_trfirst; eauto. }
+    apply Some_inj. rewrite -state_lookup_0.
+    erewrite state_lookup_after; eauto. by rewrite Nat.add_0_r.
+  Qed. 
+
+  Lemma upto_stutter_state_lookup' {btr : trace St L} {str : trace S' L'} (n : nat) bst:
+    upto_stutter Us Ul btr str
+    → btr S!! n = Some bst ->
+      ∃ (n' : nat),
+        str S!! n' = Some (Us bst).
+  Proof.
+    intros UPTO NTH.
+    pose proof (trace_has_len btr) as [? LEN]. 
+    pose proof (proj1 (state_lookup_dom _ _ LEN n) (mk_is_Some _ _ NTH)) as BOUND.
+    pose proof (proj2 (LEN _) BOUND) as [btr_n AFTER].
+    ogeneralize * (upto_stutter_after' _ _ n UPTO); eauto.
+    intros (n' & str' & AFTER' & UPTOn).
+    exists n'.
+    rewrite -(Nat.add_0_r n'). erewrite <- state_lookup_after; eauto.
+    rewrite state_lookup_0. f_equal.     
+    erewrite upto_stutter_trfirst; [..| apply UPTOn]; eauto.
+    f_equal. apply Some_inj.
+    rewrite -state_lookup_0.
+    erewrite state_lookup_after; eauto. by rewrite Nat.add_0_r.
+  Qed. 
+
+End Lookup.
diff --git a/fairis/heap_lang/examples/choose_nat/choose_nat.v b/fairis/examples/choose_nat/choose_nat.v
similarity index 96%
rename from fairis/heap_lang/examples/choose_nat/choose_nat.v
rename to fairis/examples/choose_nat/choose_nat.v
index 1909c58..4afce93 100644
--- a/fairis/heap_lang/examples/choose_nat/choose_nat.v
+++ b/fairis/examples/choose_nat/choose_nat.v
@@ -5,10 +5,8 @@ From iris.bi Require Import bi.
 From iris.base_logic.lib Require Import invariants.
 From iris.proofmode Require Import tactics.
 From trillium.prelude Require Export finitary quantifiers sigma classical_instances.
-From trillium.fairness Require Import fairness fair_termination.
-From trillium.program_logic Require Export weakestpre.
-From trillium.fairness.heap_lang Require Export lang lifting tactics proofmode.
-From trillium.fairness.heap_lang Require Import notation.
+From fairness Require Import fairness. 
+From fairis Require Import fuel lifting fair_termination proofmode heap_lang_lm. 
 
 Import derived_laws_later.bi.
 
@@ -142,7 +140,7 @@ Definition ξ_cn (l:loc) (extr : execution_trace heap_lang)
 (** Verify that the program refines the model *)
 
 (* Set up necessary RA constructions *)
-Class choose_natG Σ := ChooseNatG { choose_nat_G :> inG Σ (excl_authR ZO) }.
+Class choose_natG Σ := ChooseNatG { choose_nat_G :: inG Σ (excl_authR ZO) }.
 
 Definition choose_natΣ : gFunctors :=
   #[ heapΣ cn_fair_model; GFunctor (excl_authR ZO) ].
diff --git a/fairis/heap_lang/examples/choose_nat/choose_nat_adequacy.v b/fairis/examples/choose_nat/choose_nat_adequacy.v
similarity index 91%
rename from fairis/heap_lang/examples/choose_nat/choose_nat_adequacy.v
rename to fairis/examples/choose_nat/choose_nat_adequacy.v
index 19caf13..91d1e69 100644
--- a/fairis/heap_lang/examples/choose_nat/choose_nat_adequacy.v
+++ b/fairis/examples/choose_nat/choose_nat_adequacy.v
@@ -5,10 +5,9 @@ From iris.bi Require Import bi.
 From iris.base_logic.lib Require Import invariants.
 From iris.proofmode Require Import tactics.
 From trillium.prelude Require Export finitary quantifiers sigma classical_instances.
-From trillium.fairness Require Import fairness fair_termination fairness_finiteness.
-From trillium.program_logic Require Export weakestpre.
-From trillium.fairness.heap_lang Require Export lang lifting tactics proofmode notation adequacy.
-From trillium.fairness.heap_lang.examples Require Import choose_nat.
+From fairness Require Import fairness. 
+From fairis Require Import fuel lifting fair_termination fairness_finiteness proofmode heap_lang_lm adequacy. 
+From fairis.examples.choose_nat Require Import choose_nat.
 
 Import derived_laws_later.bi.
 
diff --git a/fairis/heap_lang/examples/even_odd/even_odd.v b/fairis/examples/even_odd/even_odd.v
similarity index 97%
rename from fairis/heap_lang/examples/even_odd/even_odd.v
rename to fairis/examples/even_odd/even_odd.v
index 75c0ee5..f048c0a 100644
--- a/fairis/heap_lang/examples/even_odd/even_odd.v
+++ b/fairis/examples/even_odd/even_odd.v
@@ -5,10 +5,8 @@ From iris.bi Require Import bi.
 From iris.base_logic.lib Require Import invariants.
 From iris.proofmode Require Import tactics.
 From trillium.prelude Require Export finitary quantifiers sigma classical_instances.
-From trillium.program_logic Require Export weakestpre.
-From trillium.fairness Require Import fairness fair_termination.
-From trillium.fairness.heap_lang Require Export lang lifting tactics proofmode.
-From trillium.fairness.heap_lang Require Import notation.
+From fairness Require Import fairness. 
+From fairis Require Import fuel lifting fair_termination proofmode heap_lang_lm. 
 
 Import derived_laws_later.bi.
 
@@ -80,10 +78,10 @@ Definition the_model: LiveModel heap_lang the_fair_model :=
 Class evenoddG Σ := EvenoddG {
   even_name: gname;
   odd_name: gname;
-  evenodd_n_G :> inG Σ (excl_authR natO);
+  evenodd_n_G :: inG Σ (excl_authR natO);
  }.
 Class evenoddPreG Σ := {
-  evenodd_PreG :> inG Σ (excl_authR natO);
+  evenodd_PreG :: inG Σ (excl_authR natO);
  }.
 Definition evenoddΣ : gFunctors :=
   #[ heapΣ the_fair_model; GFunctor (excl_authR natO) ; GFunctor (excl_authR boolO) ].
diff --git a/fairis/heap_lang/examples/even_odd/even_odd_adequacy.v b/fairis/examples/even_odd/even_odd_adequacy.v
similarity index 92%
rename from fairis/heap_lang/examples/even_odd/even_odd_adequacy.v
rename to fairis/examples/even_odd/even_odd_adequacy.v
index 987490b..7882a9d 100644
--- a/fairis/heap_lang/examples/even_odd/even_odd_adequacy.v
+++ b/fairis/examples/even_odd/even_odd_adequacy.v
@@ -4,9 +4,9 @@ From iris.algebra Require Import excl_auth.
 From iris.proofmode Require Import tactics.
 From trillium.prelude Require Export finitary quantifiers sigma classical_instances.
 From trillium.program_logic Require Export weakestpre.
-From trillium.fairness Require Import fairness fair_termination fairness_finiteness trace_utils.
-From trillium.fairness.heap_lang Require Export lang lifting tactics notation adequacy.
-From trillium.fairness.heap_lang.examples.even_odd Require Import even_odd.
+From fairness Require Import trace_utils.
+From fairis Require Import lifting adequacy fair_termination fairness_finiteness destuttering map_included_utils.
+From fairis.examples.even_odd Require Import even_odd.
 From stdpp Require Import finite.
 
 (** Helper lemmas for working with even and odd *)
@@ -74,10 +74,12 @@ Lemma evenodd_mdl_always_eventually_scheduled ρ (mtr : evenodd_mtrace) :
 Proof.
   intros Hinf Hfair n.
   apply (evenodd_mdl_always_live ρ n mtr) in Hinf.
-  specialize (Hfair n Hinf) as [m [Hfair | Hfair]].
+  specialize (Hfair n Hinf) as [m Hfair].
+  rewrite -pred_at_or in Hfair. destruct Hfair as [Hfair | Hfair].  
   - rewrite /pred_at in Hfair. destruct (after (n + m) mtr); [|done].
     rewrite /role_enabled_model in Hfair. destruct t; destruct ρ; set_solver.
-  - by exists m.
+  - eexists. eapply pred_at_impl; [| exact Hfair].
+    simpl. intros ? ? (?&->&[=]). congruence. 
 Qed.
 
 Lemma evenodd_mdl_noprogress_Even i n (mtr : evenodd_mtrace) :
@@ -97,7 +99,7 @@ Proof.
   rewrite after_sum'. rewrite Hafter. specialize (Hinf (n+1)).
   rewrite after_sum' in Hinf. rewrite Hafter in Hinf.
   destruct mtr'; [by apply is_Some_None in Hinf|].
-  eapply mtrace_valid_after in Hvalid; [|done].
+  eapply trace_valid_after in Hvalid; [|done].
   assert (ℓ ≠ Some ρEven) as Hneq.
   { assert (n < S n) by lia. specialize (Hne n H). rewrite /pred_at in Hne.
     rewrite Hafter in Hne. intros ->. apply Hne. done. }
@@ -123,7 +125,7 @@ Proof.
   rewrite after_sum'. rewrite Hafter. specialize (Hinf (n+1)).
   rewrite after_sum' in Hinf. rewrite Hafter in Hinf.
   destruct mtr'; [by apply is_Some_None in Hinf|].
-  eapply mtrace_valid_after in Hvalid; [|done].
+  eapply trace_valid_after in Hvalid; [|done].
   assert (ℓ ≠ Some ρOdd) as Hneq.
   { assert (n < S n) by lia. specialize (Hne n H). rewrite /pred_at in Hne.
     rewrite Hafter in Hne. intros ->. apply Hne. done. }
@@ -150,7 +152,7 @@ Proof.
   assert (s = trfirst mtr) as ->.
   { eapply evenodd_mdl_noprogress_Even in Hschedne; [|done..].
     rewrite /pred_at in Hschedne. rewrite Hafter in Hschedne. done. }
-  eapply mtrace_valid_after in Hvalid; [|done].
+  eapply trace_valid_after in Hvalid; [|done].
   pinversion Hvalid; simplify_eq. inversion H1; simplify_eq.
   - exists (m + 1).
     rewrite /pred_at. rewrite !after_sum'. rewrite Hafter. simpl.
@@ -176,7 +178,7 @@ Proof.
   assert (s = trfirst mtr) as ->.
   { eapply evenodd_mdl_noprogress_Odd in Hschedne; [|done..].
     rewrite /pred_at in Hschedne. rewrite Hafter in Hschedne. done. }
-  eapply mtrace_valid_after in Hvalid; [|done].
+  eapply trace_valid_after in Hvalid; [|done].
   pinversion Hvalid; simplify_eq. inversion H1; simplify_eq.
   - exists (m + 1).
     rewrite /pred_at. rewrite !after_sum'. rewrite Hafter. simpl.
@@ -197,10 +199,10 @@ Proof.
   rewrite /pred_at in Hpred.
   destruct (after n mtr) as [mtr'|] eqn:Hafter; [|done].
   eapply infinite_trace_after'' in Hinf; [|done].
-  eapply mtrace_valid_after in Hvalid; [|done].
+  eapply trace_valid_after in Hvalid; [|done].
   destruct (Nat.even i) eqn:Heqn.
   - assert (∀ ρ : fmrole the_fair_model, fair_model_trace ρ mtr') as Hfair'.
-    { intros. by eapply fair_model_trace_after. }
+    { intros. eapply fair_by_after; eauto. apply Hfair. }
     assert (trfirst mtr' = i) as Hfirst'.
     { rewrite /trfirst. destruct mtr'; done. }
     pose proof (evenodd_mdl_progresses_Even i mtr' Hinf Hvalid Hfair' Hfirst')
@@ -208,7 +210,7 @@ Proof.
     exists (n + m).
     rewrite pred_at_sum. rewrite Hafter. done.
   - assert (∀ ρ : fmrole the_fair_model, fair_model_trace ρ mtr') as Hfair'.
-    { intros. by eapply fair_model_trace_after. }
+    { intros. eapply fair_by_after; eauto. apply Hfair. }
     assert (trfirst mtr' = i) as Hfirst'.
     { rewrite /trfirst. destruct mtr'; done. }
     pose proof (evenodd_mdl_progresses_Odd i mtr' Hinf Hvalid Hfair' Hfirst')
@@ -233,7 +235,7 @@ Proof.
   split; [done|].
   replace (S n) with (n + 1) by lia.
   rewrite after_sum'. rewrite Hafter. simpl.
-  eapply mtrace_valid_after in Hvalid; [|done].
+  eapply trace_valid_after in Hvalid; [|done].
   punfold Hvalid. inversion Hvalid as [|??? Htrans]. simplify_eq.
   inversion Htrans; simplify_eq.
   - destruct mtr'.
@@ -257,6 +259,39 @@ Definition evenodd_aux_progress (auxtr : auxtrace the_model) :=
   ∀ i, ∃ n, pred_at auxtr n (λ s l, (λ s' _, s' = i)
                                       (ls_under s) (l ≫= Ul)).
 
+(* TODO: move to fairness/trace_utils *)
+Lemma trace_eventually_stutter_preserves 
+      {St S' L L': Type} (Us: St -> S') (Ul: L -> option L')
+      tr1 tr2 P :
+  upto_stutter Us Ul tr1 tr2 →
+  trace_eventually tr2 P →
+  trace_eventually tr1 (λ s l, P (Us s) (l ≫= Ul)).
+Proof.
+  intros Hstutter [n Heventually].
+  revert tr1 tr2 Hstutter Heventually.
+  induction n as [|n IHn]; intros tr1 tr2 Hstutter Heventually.
+  - punfold Hstutter; [|apply upto_stutter_mono].
+    induction Hstutter.
+    + rewrite /pred_at in Heventually. simpl in *. exists 0. rewrite /pred_at. simpl in *. done.
+    + destruct (IHHstutter Heventually) as [n Heventually'].
+      exists (1 + n). rewrite /pred_at. rewrite after_sum'. simpl.
+      done.
+    + rewrite /pred_at in Heventually. simpl in *. exists 0. rewrite /pred_at. simpl.
+      simplify_eq. rewrite H0. done.
+  - punfold Hstutter; [|apply upto_stutter_mono].
+    induction Hstutter.
+    + rewrite /pred_at in Heventually. simpl in *. exists 0. rewrite /pred_at. simpl in *. done.
+    + destruct (IHHstutter Heventually) as [n' Heventually'].
+      exists (1 + n'). rewrite /pred_at. rewrite after_sum'. simpl.
+      done.
+    + apply trace_eventually_cons.
+      assert (pred_at str n P) as Heventually'.
+      { rewrite /pred_at in Heventually.
+        simpl in *. done. }
+      eapply IHn; [|done].
+      rewrite /upaco2 in H1. destruct H1; [done|done].
+Qed.
+
 Lemma evenodd_mtr_aux_progress_preserved
       (mtr : mtrace the_fair_model)
       (auxtr : auxtrace the_model) :
@@ -462,7 +497,7 @@ Proof.
       rewrite Hv. destruct k; [done|]. destruct es; [done|].
       simpl in *. rewrite drop_0. rewrite list_lookup_fmap.
       erewrite prefixes_from_lookup; [|done].
-      simpl. rewrite /locale_of. rewrite take_length.
+      simpl. rewrite /locale_of. rewrite length_take.
       assert (k < length es).
       { apply lookup_lt_is_Some_1. by eauto. }
       by replace (k `min` length es) with k by lia. }
diff --git a/fairis/heap_lang/examples/yesno/yesno.v b/fairis/examples/yesno/yesno.v
similarity index 98%
rename from fairis/heap_lang/examples/yesno/yesno.v
rename to fairis/examples/yesno/yesno.v
index c06698d..f96ca2c 100644
--- a/fairis/heap_lang/examples/yesno/yesno.v
+++ b/fairis/examples/yesno/yesno.v
@@ -6,8 +6,8 @@ From iris.base_logic.lib Require Import invariants.
 From iris.proofmode Require Import tactics.
 From trillium.prelude Require Export finitary quantifiers sigma classical_instances.
 From trillium.program_logic Require Export weakestpre.
-From trillium.fairness Require Import fairness fair_termination.
-From trillium.fairness.heap_lang Require Export lang lifting tactics proofmode  notation.
+From fairness Require Import fairness. 
+From fairis Require Import fuel lifting fair_termination proofmode heap_lang_lm. 
 
 Import derived_laws_later.bi.
 
@@ -92,12 +92,12 @@ Definition the_model: LiveModel heap_lang the_fair_model :=
 Class yesnoG Σ := YesnoG {
   yes_name: gname;
   no_name: gname;
-  yesno_n_G :> inG Σ (excl_authR natO);
-  yesno_f_G :> inG Σ (excl_authR boolO);
+  yesno_n_G :: inG Σ (excl_authR natO);
+  yesno_f_G :: inG Σ (excl_authR boolO);
  }.
 Class yesnoPreG Σ := {
-  yesno_PreG :> inG Σ (excl_authR natO);
-  yesno_f_PreG :> inG Σ (excl_authR boolO);
+  yesno_PreG :: inG Σ (excl_authR natO);
+  yesno_f_PreG :: inG Σ (excl_authR boolO);
  }.
 Definition yesnoΣ : gFunctors :=
   #[ heapΣ the_fair_model; GFunctor (excl_authR natO) ; GFunctor (excl_authR boolO) ].
diff --git a/fairis/heap_lang/examples/yesno/yesno_adequacy.v b/fairis/examples/yesno/yesno_adequacy.v
similarity index 97%
rename from fairis/heap_lang/examples/yesno/yesno_adequacy.v
rename to fairis/examples/yesno/yesno_adequacy.v
index 8533225..7ab473b 100644
--- a/fairis/heap_lang/examples/yesno/yesno_adequacy.v
+++ b/fairis/examples/yesno/yesno_adequacy.v
@@ -1,9 +1,9 @@
 From iris.proofmode Require Import tactics.
 From trillium.program_logic Require Export weakestpre.
-From trillium.fairness Require Import fairness fair_termination fairness_finiteness.
+From fairness Require Import fairness. 
 From trillium.prelude Require Export finitary quantifiers sigma classical_instances.
-From trillium.fairness.heap_lang Require Export lang lifting tactics notation adequacy.
-From trillium.fairness.heap_lang.examples.yesno Require Import yesno.
+From fairis Require Import lifting adequacy fair_termination fairness_finiteness.
+From fairis.examples.yesno Require Import yesno.
 
 From stdpp Require Import finite.
 
diff --git a/fairis/fair_termination.v b/fairis/fair_termination.v
index 08d83a3..35f65f5 100644
--- a/fairis/fair_termination.v
+++ b/fairis/fair_termination.v
@@ -1,6 +1,8 @@
-From trillium.fairness Require Export fairness.
+From fairness Require Export fairness.
 From stdpp Require Import option.
 From Paco Require Import pacotac.
+From iris.proofmode Require Import tactics.
+
 
 (* TODO: See if we can generalise the notion of fair terminating traces *)
 Definition mtrace_fairly_terminating {Mdl : FairModel} (mtr : mtrace Mdl) :=
@@ -8,12 +10,6 @@ Definition mtrace_fairly_terminating {Mdl : FairModel} (mtr : mtrace Mdl) :=
   (∀ ρ, fair_model_trace ρ mtr) →
   terminating_trace mtr.
 
-Definition extrace_fairly_terminating {Λ} `{Countable (locale Λ)}
-           (extr : extrace Λ) :=
-  extrace_valid extr →
-  (∀ tid, fair_ex tid extr) →
-  terminating_trace extr.
-
 Class FairTerminatingModel (Mdl: FairModel) := {
   ftm_leq: relation Mdl;
   ftm_order: PreOrder ftm_leq;
@@ -73,15 +69,27 @@ Proof.
     first by rewrite /pred_at /=; destruct mtr.
   revert mtr Hval Hleq Hfair Hlive IH Hev Htrdec. induction n as [| n IHn];
     intros mtr Hval Hleq Hfair Hlive IH Hev Htrdec.
-  - simpl in *. rewrite /pred_at /= in Hev.
-    destruct Hev as [Hev|Hev]; first by destruct mtr; done.
-    destruct mtr; first done. injection Hev => ->.
+  - simpl in *.
+    
+    (* replace (fairness_sat role_enabled_model role_match *)
+    (*      (ftm_decreasing_role (trfirst mtr))) with ((fun c => fairness_sat role_enabled_model role_match *)
+    (*      (ftm_decreasing_role c)) (trfirst mtr)) in Hev. *)
+    
+    rewrite /pred_at /= in Hev.
+    (* destruct Hev as [Hev|Hev]; first by destruct mtr; done. *)
+    destruct mtr.
+    { exists 1. done. }
+    destruct Hev as [Hev|Hev]; [done| ].
+    rewrite /role_match in Hev.
+    destruct Hev as (? & [=<-] & EQ). simpl in EQ. 
+    simpl. 
     apply terminating_trace_cons.
     eapply IH =>//; eauto.
     + eapply ftm_trans' =>//. apply Htrdec.
       punfold Hval. inversion Hval; simplify_eq; simpl in *; simplify_eq; done.
     + punfold Hval. inversion Hval; simplify_eq.
       destruct H4; done.
+    + eapply fair_by_cons_forall; eauto.  
   - simpl in *. destruct mtr; first (exists 1; done).
     rewrite -> !pred_at_S in Hev.
     punfold Hval; inversion Hval as [|??? Htrans Hval']; simplify_eq.
@@ -89,11 +97,13 @@ Proof.
     destruct (decide (ℓ = Some (ftm_decreasing_role s))) as [-> | Hnoteq].
     + apply terminating_trace_cons. eapply IH=>//; eauto.
       eapply ftm_trans' =>//; apply Htrdec. simpl. destruct Hval;done.
+      eapply fair_by_cons_forall; eauto. 
     + destruct mtr as [|s' ℓ' mtr''] eqn:Heq; first by eexists 2.
       destruct (ftm_decr (trfirst mtr)) as (Hlive' & Htrdec').
       { exists ℓ', (trfirst mtr''). punfold Hval'; inversion Hval'; subst; done. }
       apply terminating_trace_cons. eapply IHn=>//; eauto.
       * etransitivity; eauto. eapply ftm_notinc =>//.
+      * eapply fair_by_cons_forall; eauto. 
       * simplify_eq. eapply Hlive'.
       * erewrite <- ftm_decreasing_role_preserved =>//.
       * intros s'' Htrans''. eapply ftm_decr; eauto.
diff --git a/fairis/fairness.v b/fairis/fairness.v
index c53c183..53edc6b 100644
--- a/fairis/fairness.v
+++ b/fairis/fairness.v
@@ -1,170 +1,89 @@
-From stdpp Require Import option.
-From Paco Require Import paco1 paco2 pacotac.
-From trillium.fairness Require Export inftraces.
-
-Record FairModel : Type := {
-  fmstate:> Type;
-  fmstate_eqdec: EqDecision fmstate;
-  fmstate_inhabited: Inhabited fmstate;
-
-  fmrole: Type;
-  fmrole_eqdec: EqDecision fmrole;
-  fmrole_countable: Countable fmrole;
-  fmrole_inhabited: Inhabited fmrole;
-
-  fmtrans: fmstate -> option fmrole -> fmstate -> Prop;
-
-  live_roles: fmstate -> gset fmrole;
-  fm_live_spec: forall s ρ s', fmtrans s (Some ρ) s' -> ρ ∈ live_roles s;
-}.
-
-#[global] Existing Instance fmrole_eqdec.
-#[global] Existing Instance fmrole_countable.
-#[global] Existing Instance fmrole_inhabited.
-#[global] Existing Instance fmstate_inhabited.
-
-(* Basically, soundness of the logic and the lemmas above tell us that we have a program
-   trace and a model trace which are related by traces_match labels_math!
-
-   We now prove that this relation transports the properties we care about; the first
-   place of which is fairness.
- *)
-
-(* Definition of fairness for both kinds of traces *)
-
-Definition extrace Λ := trace (cfg Λ) (olocale Λ).
-
-Section exec_trace.
-  Context {Λ : language}.
-  Context `{EqDecision (locale Λ)}.
-
-  Definition locale_enabled (ζ : locale Λ) (c: cfg Λ) :=
-    ∃ e, from_locale c.1 ζ = Some e ∧ to_val e = None.
-
-  Definition fair_ex ζ (extr: extrace Λ): Prop :=
-    forall n, pred_at extr n (λ c _, locale_enabled ζ c) ->
-         ∃ m, pred_at extr (n+m) (λ c _, ¬locale_enabled ζ c)
-              ∨ pred_at extr (n+m) (λ _ otid, otid = Some (Some ζ)).
-
-  Lemma fair_ex_after ζ tr tr' k:
-    after k tr = Some tr' ->
-    fair_ex ζ tr -> fair_ex ζ tr'.
-  Proof.
-    intros Haf Hf n Hp.
-    have Hh:= Hf (k+n).
-    have Hp': pred_at tr (k + n) (λ (c : cfg Λ) (_ : option (olocale Λ)), locale_enabled ζ c).
-    { rewrite (pred_at_sum _ k) Haf /= //. }
-    have [m Hm] := Hh Hp'. exists m.
-    by rewrite <- Nat.add_assoc, !(pred_at_sum _ k), Haf in Hm.
-  Qed.
-
-  Lemma fair_ex_cons tid c tid' r:
-    fair_ex tid (c -[tid']-> r) -> fair_ex tid r.
-  Proof. intros H. by eapply (fair_ex_after tid (c -[tid']-> r) r 1). Qed.
-
-  CoInductive extrace_valid: extrace Λ -> Prop :=
-  | extrace_valid_singleton c: extrace_valid ⟨c⟩
-  | extrace_valid_cons c oζ tr:
-      locale_step c oζ (trfirst tr) ->
-      extrace_valid tr →
-      extrace_valid (c -[oζ]-> tr).
-
-  Lemma to_trace_preserves_validity ex iex:
-    extrace_valid (to_trace (trace_last ex) iex) -> valid_exec ex -> valid_inf_exec ex iex.
-  Proof.
-    revert ex iex. cofix CH. intros ex iex Hexval Hval.
-    rewrite (trace_unfold_fold (to_trace _ _)) in Hexval.
-    destruct iex as [|[??] iex]; first by econstructor. cbn in Hexval.
-    inversion Hexval. simplify_eq.
-    econstructor; try done.
-    - by destruct iex as [|[??]?].
-    - apply CH; eauto. econstructor; try done. by destruct iex as [|[??]?].
-  Qed.
-
-  Lemma from_trace_preserves_validity (extr: extrace Λ) ex:
-    extrace_valid extr ->
-    valid_exec ex ->
-    trace_last ex = trfirst extr ->
-    valid_inf_exec ex (from_trace extr).
-  Proof.
-    revert ex extr. cofix CH. intros ex extr Hexval Hval Heq.
-    rewrite (inflist_unfold_fold (from_trace extr)). destruct extr as [c|c tid tr]; cbn;
-     first by econstructor.
-    inversion Hexval; simplify_eq; econstructor; eauto. apply CH; eauto.
-      by econstructor.
-  Qed.
-
-  Lemma from_trace_preserves_validity_singleton (extr: extrace Λ):
-    extrace_valid extr ->
-    valid_inf_exec (trace_singleton (trfirst extr)) (from_trace extr).
-  Proof.
-    intros ?. eapply from_trace_preserves_validity; eauto. econstructor.
-  Qed.
-
-End exec_trace.
-
-Definition mtrace (M:FairModel) := trace M (option M.(fmrole)).
-
-Section model_traces.
-  Context `{M: FairModel}.
-
-  Definition role_enabled_model ρ (s: M) := ρ ∈ M.(live_roles) s.
-
-  Definition fair_model_trace ρ (mtr: mtrace M): Prop  :=
-    forall n, pred_at mtr n (λ δ _, role_enabled_model ρ δ) ->
-         ∃ m, pred_at mtr (n+m) (λ δ _, ¬role_enabled_model ρ δ)
-              ∨ pred_at mtr (n+m) (λ _ ℓ, ℓ = Some (Some ρ)).
-
-  Lemma fair_model_trace_after ℓ tr tr' k:
-    after k tr = Some tr' ->
-    fair_model_trace ℓ tr -> fair_model_trace ℓ tr'.
-  Proof.
-    intros Haf Hf n Hp.
-    have Hh:= Hf (k+n).
-    have Hp': pred_at tr (k + n) (λ δ _, role_enabled_model ℓ δ).
-    { rewrite (pred_at_sum _ k) Haf /= //. }
-    have [m Hm] := Hh Hp'. exists m.
-    by rewrite <- Nat.add_assoc, !(pred_at_sum _ k), Haf in Hm.
-  Qed.
-
-  Lemma fair_model_trace_cons ℓ δ ℓ' r:
-    fair_model_trace ℓ (δ -[ℓ']-> r) -> fair_model_trace ℓ r.
-  Proof. intros Hfm. by eapply (fair_model_trace_after ℓ _ r 1) =>//. Qed.
-
-  Lemma fair_model_trace_cons_forall δ ℓ' r:
-    (∀ ℓ, fair_model_trace ℓ (δ -[ℓ']-> r)) -> (∀ ℓ, fair_model_trace ℓ r).
-  Proof. eauto using fair_model_trace_cons. Qed.
-
-  Inductive mtrace_valid_ind (mtrace_valid_coind: mtrace M -> Prop) :
-    mtrace M -> Prop :=
-  | mtrace_valid_singleton δ: mtrace_valid_ind _ ⟨δ⟩
-  | mtrace_valid_cons δ ℓ tr:
-      fmtrans _ δ ℓ (trfirst tr) ->
-      mtrace_valid_coind tr →
-      mtrace_valid_ind _ (δ -[ℓ]-> tr).
-  Definition mtrace_valid := paco1 mtrace_valid_ind bot1.
-
-  Lemma mtrace_valid_mono :
-    monotone1 mtrace_valid_ind.
-  Proof.
-    unfold monotone1. intros x0 r r' IN LE.
-    induction IN; try (econstructor; eauto; done).
-  Qed.
-  Hint Resolve mtrace_valid_mono : paco.
-
-  Lemma mtrace_valid_after (mtr mtr' : mtrace M) k :
-    after k mtr = Some mtr' → mtrace_valid mtr → mtrace_valid mtr'.
-  Proof.
-    revert mtr mtr'.
-    induction k; intros mtr mtr' Hafter Hvalid.
-    { destruct mtr'; simpl in *; by simplify_eq. }
-    punfold Hvalid.
-    inversion Hvalid as [|??? Htrans Hval']; simplify_eq.
-    eapply IHk; [done|].
-    by inversion Hval'.
-  Qed.
-
-End model_traces.
-
-Global Hint Resolve fair_model_trace_cons: core.
-Global Hint Resolve mtrace_valid_mono : paco.
+(* From stdpp Require Import option. *)
+(* From Paco Require Import paco1 paco2 pacotac. *)
+(* From trillium.fairness Require Export inftraces. *)
+
+(* Record FairModel : Type := { *)
+(*   fmstate:> Type; *)
+(*   fmstate_eqdec: EqDecision fmstate; *)
+(*   fmstate_inhabited: Inhabited fmstate; *)
+
+(*   fmrole: Type; *)
+(*   fmrole_eqdec: EqDecision fmrole; *)
+(*   fmrole_countable: Countable fmrole; *)
+(*   fmrole_inhabited: Inhabited fmrole; *)
+
+(*   fmtrans: fmstate -> option fmrole -> fmstate -> Prop; *)
+
+(*   live_roles: fmstate -> gset fmrole; *)
+(*   fm_live_spec: forall s ρ s', fmtrans s (Some ρ) s' -> ρ ∈ live_roles s; *)
+(* }. *)
+
+(* #[global] Existing Instance fmrole_eqdec. *)
+(* #[global] Existing Instance fmrole_countable. *)
+(* #[global] Existing Instance fmrole_inhabited. *)
+(* #[global] Existing Instance fmstate_inhabited. *)
+
+
+(* Section model_traces. *)
+(*   Context `{M: FairModel}. *)
+
+(*   Definition role_enabled_model ρ (s: M) := ρ ∈ M.(live_roles) s. *)
+
+(*   Definition fair_model_trace ρ (mtr: mtrace M): Prop  := *)
+(*     forall n, pred_at mtr n (λ δ _, role_enabled_model ρ δ) -> *)
+(*          ∃ m, pred_at mtr (n+m) (λ δ _, ¬role_enabled_model ρ δ) *)
+(*               ∨ pred_at mtr (n+m) (λ _ ℓ, ℓ = Some (Some ρ)). *)
+
+(*   Lemma fair_model_trace_after ℓ tr tr' k: *)
+(*     after k tr = Some tr' -> *)
+(*     fair_model_trace ℓ tr -> fair_model_trace ℓ tr'. *)
+(*   Proof. *)
+(*     intros Haf Hf n Hp. *)
+(*     have Hh:= Hf (k+n). *)
+(*     have Hp': pred_at tr (k + n) (λ δ _, role_enabled_model ℓ δ). *)
+(*     { rewrite (pred_at_sum _ k) Haf /= //. } *)
+(*     have [m Hm] := Hh Hp'. exists m. *)
+(*     by rewrite <- Nat.add_assoc, !(pred_at_sum _ k), Haf in Hm. *)
+(*   Qed. *)
+
+(*   Lemma fair_model_trace_cons ℓ δ ℓ' r: *)
+(*     fair_model_trace ℓ (δ -[ℓ']-> r) -> fair_model_trace ℓ r. *)
+(*   Proof. intros Hfm. by eapply (fair_model_trace_after ℓ _ r 1) =>//. Qed. *)
+
+(*   Lemma fair_model_trace_cons_forall δ ℓ' r: *)
+(*     (∀ ℓ, fair_model_trace ℓ (δ -[ℓ']-> r)) -> (∀ ℓ, fair_model_trace ℓ r). *)
+(*   Proof. eauto using fair_model_trace_cons. Qed. *)
+
+(*   Inductive mtrace_valid_ind (mtrace_valid_coind: mtrace M -> Prop) : *)
+(*     mtrace M -> Prop := *)
+(*   | mtrace_valid_singleton δ: mtrace_valid_ind _ ⟨δ⟩ *)
+(*   | mtrace_valid_cons δ ℓ tr: *)
+(*       fmtrans _ δ ℓ (trfirst tr) -> *)
+(*       mtrace_valid_coind tr → *)
+(*       mtrace_valid_ind _ (δ -[ℓ]-> tr). *)
+(*   Definition mtrace_valid := paco1 mtrace_valid_ind bot1. *)
+
+(*   Lemma mtrace_valid_mono : *)
+(*     monotone1 mtrace_valid_ind. *)
+(*   Proof. *)
+(*     unfold monotone1. intros x0 r r' IN LE. *)
+(*     induction IN; try (econstructor; eauto; done). *)
+(*   Qed. *)
+(*   Hint Resolve mtrace_valid_mono : paco. *)
+
+(*   Lemma mtrace_valid_after (mtr mtr' : mtrace M) k : *)
+(*     after k mtr = Some mtr' → mtrace_valid mtr → mtrace_valid mtr'. *)
+(*   Proof. *)
+(*     revert mtr mtr'. *)
+(*     induction k; intros mtr mtr' Hafter Hvalid. *)
+(*     { destruct mtr'; simpl in *; by simplify_eq. } *)
+(*     punfold Hvalid. *)
+(*     inversion Hvalid as [|??? Htrans Hval']; simplify_eq. *)
+(*     eapply IHk; [done|]. *)
+(*     by inversion Hval'. *)
+(*   Qed. *)
+
+(* End model_traces. *)
+
+(* Global Hint Resolve fair_model_trace_cons: core. *)
+(* Global Hint Resolve mtrace_valid_mono : paco. *)
diff --git a/fairis/fairness_finiteness.v b/fairis/fairness_finiteness.v
index 511a189..29fa9ce 100644
--- a/fairis/fairness_finiteness.v
+++ b/fairis/fairness_finiteness.v
@@ -1,6 +1,7 @@
 From stdpp Require Import finite.
 From trillium.prelude Require Import finitary quantifiers classical_instances.
-From trillium.fairness Require Import fairness fuel.
+From fairness Require Import fairness.
+From fairis Require Import fuel.
 
 Section gmap.
   Context `{!EqDecision K, !Countable K}.
diff --git a/fairis/fuel.v b/fairis/fuel.v
index 2c5d49f..485d1d2 100644
--- a/fairis/fuel.v
+++ b/fairis/fuel.v
@@ -1,7 +1,9 @@
-From stdpp Require Import option.
+From stdpp Require Import option gmap.
 From Paco Require Import paco1 paco2 pacotac.
 From trillium.program_logic Require Export adequacy.
-From trillium.fairness Require Export inftraces fairness.
+From fairness Require Export inftraces fairness.
+From fairis Require Import destuttering.
+
 
 Section fairness.
   Context {Λ : language}.
@@ -759,6 +761,17 @@ Section fairness_preserved.
       ∃ M, pred_at auxtr M (λ δ _, ¬role_enabled ρ δ)
            ∨ pred_at auxtr M (λ _ ℓ, ∃ ζ0, ℓ = Some (Take_step ρ ζ0))).
 
+  Local Lemma pred_at_step_helper extr' p ζ':
+    pred_at extr' p (fairness_sat locale_enabled tid_match ζ') <->
+    pred_at extr' p (λ x y, ¬ locale_enabled ζ' x ∨ y = Some (Some ζ')).
+  Proof using.
+    apply pred_at_iff. intros ??. 
+    rewrite /fairness_sat. apply Morphisms_Prop.or_iff_morphism; [done| ].
+    rewrite /tid_match. split.
+    - by intros (?&->&[=->]).
+    - intros ->. eauto.  
+  Qed.
+
   Local Lemma case1 ρ f m (extr' : extrace Λ) (auxtr' : auxtrace LM) δ ℓ :
     (∀ m0 : nat * nat,
          strict lt_lex m0 (f, m)
@@ -792,7 +805,10 @@ Section fairness_preserved.
         have [P Hind] : ∃ M0 : nat, pred_at auxtr' M0 (λ (δ0 : LiveState Λ M) _, ¬ role_enabled ρ δ0)
                                   ∨ pred_at auxtr' M0 (λ (_ : LiveState Λ M) ℓ, ∃ ζ0, ℓ = Some (Take_step ρ ζ0)).
         { eapply (IH _ _ _ p _ extr'); eauto.
-          Unshelve. unfold strict, lt_lex. specialize (Hdec ltac:(by eapply elem_of_dom_2)). lia. }
+          rewrite pred_at_or. eapply pred_at_step_helper; eauto.
+          Unshelve.
+          unfold strict, lt_lex. specialize (Hdec ltac:(by eapply elem_of_dom_2)).
+          lia. }
         exists (1+P). rewrite !pred_at_sum. simpl. done.
       - exists 1. left. rewrite /pred_at /=. rewrite /role_enabled.
         destruct auxtr' =>/=.
@@ -809,7 +825,7 @@ Section fairness_preserved.
     destruct extr as [|c ζ' extr'] eqn:Heq.
     { have [??] := Hexinfin 1. done. }
     have Hfair': (forall ζ, fair_ex ζ extr').
-    { intros. by eapply fair_ex_cons. }
+    { intros. eapply fair_by_cons. apply Hfair. }
     destruct auxtr as [|δ ℓ auxtr']; first by inversion Htm.
     destruct (decide (ρ ∈ live_roles M δ)) as [Hρlive|]; last first.
     { exists 0. left. unfold pred_at. simpl. intros contra. eauto. }
@@ -924,8 +940,12 @@ Section fairness_preserved.
         have [p Hp] := (Hfair' ζ'' 0 Hζ'en).
         have [P Hind] : ∃ M0 : nat, pred_at auxtr' M0 (λ δ0 _, ¬ role_enabled ρ δ0)
                         ∨ pred_at auxtr' M0 (λ _ ℓ, ∃ ζ0, ℓ = Some (Take_step ρ ζ0)).
-        { eapply (IH _ _ _ p _ extr'); eauto. by eapply infinite_cons. by inversion Htm.
-          Unshelve. unfold strict, lt_lex. lia. }
+        { eapply (IH _ _ _ p _ extr'); eauto.
+          { by eapply infinite_cons. }
+          { by inversion Htm. }
+          rewrite pred_at_or. eapply pred_at_step_helper; eauto.
+          Unshelve.
+          unfold strict, lt_lex. lia. }
         exists (1+P). rewrite !pred_at_sum. simpl. done.
   Qed.
 
@@ -957,7 +977,9 @@ Section fairness_preserved.
     have ?: infinite_trace tr1'.
     { have Hinf := infinite_trace_after n extr Hinfin. by rewrite Heq' in Hinf. }
     eapply (fairness_preserved_ind ρ _ f m ζ _ tr); eauto.
-    intros ?. by eapply fair_ex_after.
+    intros ?. eapply fair_by_after; eauto. 
+    { apply Hex. }
+    rewrite pred_at_or. eapply pred_at_step_helper; eauto.     
   Qed.
 
   Tactic Notation "inv" open_constr(P) := match goal with
@@ -1246,6 +1268,10 @@ Section upto_stutter_preserves_fairness_and_termination.
     { rewrite /pred_at /=. destruct auxtr'; done. }
     destruct (upto_stutter_fairness_0 ρ auxtr' mtr' Hupto' (Hfa' Hpredat)) as (m&Hres).
     exists m. rewrite !(pred_at_sum _ n) Heq //.
+    rewrite pred_at_or in Hres. 
+    eapply pred_at_impl; [| by apply Hres].
+    simpl. rewrite /fairness_sat. intros ?? [? | ->]; eauto.
+    right. eexists. split; done.
   Qed.
 
   Lemma upto_stutter_finiteness auxtr (mtr: mtrace M):
diff --git a/fairis/fuel_termination.v b/fairis/fuel_termination.v
index b6d9fcd..47ceab0 100644
--- a/fairis/fuel_termination.v
+++ b/fairis/fuel_termination.v
@@ -1,6 +1,7 @@
 From stdpp Require Import option.
 From Paco Require Import pacotac.
-From trillium.fairness Require Export fairness fair_termination fuel.
+From fairness Require Export fairness.
+From fairis Require Import fair_termination fuel.
 
 Definition auxtrace_fairly_terminating {Λ} `{Countable (locale Λ)} {Mdl : FairModel}
            {LM : LiveModel Λ Mdl} (auxtr : auxtrace LM) :=
diff --git a/fairis/heap_lang/lifting.v b/fairis/heap_lang/lifting.v
deleted file mode 100644
index a1b3093..0000000
--- a/fairis/heap_lang/lifting.v
+++ /dev/null
@@ -1,594 +0,0 @@
-From stdpp Require Import fin_maps.
-From iris.proofmode Require Import tactics.
-From iris.algebra Require Import auth gmap gset excl.
-From iris.base_logic Require Export gen_heap.
-From trillium.prelude Require Import classical_instances.
-From trillium.program_logic Require Export weakestpre adequacy.
-From trillium.fairness Require Export fairness resources fair_termination fuel fuel_termination.
-From trillium.program_logic Require Import ectx_lifting.
-From trillium.fairness.heap_lang Require Export lang.
-From trillium.fairness.heap_lang Require Import tactics notation.
-Set Default Proof Using "Type".
-
-Canonical Structure ModelO (M : FairModel) := leibnizO M.
-Canonical Structure RoleO (M : FairModel) := leibnizO (M.(fmrole)).
-
-Class heapGpreS Σ `(LM: LiveModel heap_lang M) := HeapPreG {
-  heapGpreS_inv :> invGpreS Σ;
-  heapGpreS_gen_heap :> gen_heapGpreS loc val Σ;
-  heapGpreS_fairness :> fairnessGpreS LM Σ;
-}.
-
-Class heapGS Σ `(LM:LiveModel heap_lang M) := HeapG {
-  heap_inG :> heapGpreS Σ LM;
-  heap_invGS : invGS_gen HasNoLc Σ;
-  heap_gen_heapGS :> gen_heapGS loc val Σ;
-  heap_fairnessGS :> fairnessGS LM Σ;
-}.
-
-Definition heapΣ (M : FairModel) : gFunctors :=
-  #[ invΣ; gen_heapΣ loc val; fairnessΣ heap_lang M ].
-
-Global Instance subG_heapPreG {Σ} `{LM : LiveModel heap_lang M} :
-  subG (heapΣ M) Σ → heapGpreS Σ LM.
-Proof. solve_inG. Qed.
-
-#[global] Instance heapG_irisG `{LM:LiveModel heap_lang M} `{!heapGS Σ LM} : irisG heap_lang LM Σ := {
-    iris_invGS := heap_invGS;
-    state_interp extr auxtr :=
-      (⌜valid_state_evolution_fairness extr auxtr⌝ ∗
-       gen_heap_interp (trace_last extr).2.(heap) ∗
-       model_state_interp (trace_last extr).1 (trace_last auxtr))%I ;
-    fork_post tid := λ _, (tid ↦M ∅)%I;
-}.
-
-(** Override the notations so that scopes and coercions work out *)
-Notation "l ↦{ q } v" := (pointsto (L:=loc) (V:=val) l (DfracOwn q) v%V)
-  (at level 20, q at level 50, format "l  ↦{ q }  v") : bi_scope.
-Notation "l ↦ v" :=
-  (pointsto (L:=loc) (V:=val) l (DfracOwn 1) v%V) (at level 20) : bi_scope.
-Notation "l ↦{ q } -" := (∃ v, l ↦{q} v)%I
-  (at level 20, q at level 50, format "l  ↦{ q }  -") : bi_scope.
-Notation "l ↦ -" := (l ↦{1} -)%I (at level 20) : bi_scope.
-
-(** The tactic [inv_head_step] performs inversion on hypotheses of the shape
-[head_step]. The tactic will discharge head-reductions starting from values, and
-simplifies hypothesis related to conversions from and to values, and finite map
-operations. This tactic is slightly ad-hoc and tuned for proving our lifting
-lemmas. *)
-Ltac inv_head_step :=
-  repeat match goal with
-  | _ => progress simplify_map_eq/= (* simplify memory stuff *)
-  | H : to_val _ = Some _ |- _ => apply of_to_val in H
-  | H : head_step ?e _ _ _ _ |- _ =>
-     try (is_var e; fail 1); (* inversion yields many goals if [e] is a variable
-     and can thus better be avoided. *)
-     inversion H; subst; clear H
-  end.
-
-Local Hint Extern 0 (head_reducible _ _) => eexists _, _, _; simpl : core.
-Local Hint Extern 1 (head_step _ _ _ _ _) => econstructor : core.
-Local Hint Extern 0 (head_step (CmpXchg _ _ _) _ _ _ _) => eapply CmpXchgS : core.
-Local Hint Extern 0 (head_step (AllocN _ _) _ _ _ _) => apply alloc_fresh : core.
-Local Hint Resolve to_of_val : core.
-
-#[global] Instance into_val_val v : IntoVal (Val v) v.
-Proof. done. Qed.
-#[global] Instance as_val_val v : AsVal (Val v).
-Proof. by eexists. Qed.
-
-Local Ltac solve_atomic :=
-  apply strongly_atomic_atomic, ectx_language_atomic;
-    [inversion 1; naive_solver
-    |apply ectxi_language_sub_redexes_are_values; intros [] **; naive_solver].
-
-#[global] Instance rec_atomic s f x e : Atomic s (Rec f x e).
-Proof. solve_atomic. Qed.
-#[global] Instance pair_atomic s v1 v2 : Atomic s (Pair (Val v1) (Val v2)).
-Proof. solve_atomic. Qed.
-#[global] Instance injl_atomic s v : Atomic s (InjL (Val v)).
-Proof. solve_atomic. Qed.
-#[global] Instance injr_atomic s v : Atomic s (InjR (Val v)).
-Proof. solve_atomic. Qed.
-(** The instance below is a more general version of [Skip] *)
-#[global] Instance beta_atomic s f x v1 v2 : Atomic s (App (RecV f x (Val v1)) (Val v2)).
-Proof. destruct f, x; solve_atomic. Qed.
-#[global] Instance unop_atomic s op v : Atomic s (UnOp op (Val v)).
-Proof. solve_atomic. Qed.
-#[global] Instance binop_atomic s op v1 v2 : Atomic s (BinOp op (Val v1) (Val v2)).
-Proof. solve_atomic. Qed.
-#[global] Instance if_true_atomic s v1 e2 : Atomic s (If (Val $ LitV $ LitBool true) (Val v1) e2).
-Proof. solve_atomic. Qed.
-#[global] Instance if_false_atomic s e1 v2 : Atomic s (If (Val $ LitV $ LitBool false) e1 (Val v2)).
-Proof. solve_atomic. Qed.
-#[global] Instance fst_atomic s v : Atomic s (Fst (Val v)).
-Proof. solve_atomic. Qed.
-#[global] Instance snd_atomic s v : Atomic s (Snd (Val v)).
-Proof. solve_atomic. Qed.
-
-#[global] Instance fork_atomic s e : Atomic s (Fork e).
-Proof. solve_atomic. Qed.
-
-#[global] Instance allocN_atomic s v w : Atomic s (AllocN (Val v) (Val w)).
-Proof. solve_atomic. Qed.
-#[global] Instance alloc_atomic s v : Atomic s (Alloc (Val v)).
-Proof. solve_atomic. Qed.
-#[global] Instance load_atomic s v : Atomic s (Load (Val v)).
-Proof. solve_atomic. Qed.
-#[global] Instance store_atomic s v1 v2 : Atomic s (Store (Val v1) (Val v2)).
-Proof. solve_atomic. Qed.
-#[global] Instance cmpxchg_atomic s v0 v1 v2 : Atomic s (CmpXchg (Val v0) (Val v1) (Val v2)).
-Proof. solve_atomic. Qed.
-#[global] Instance faa_atomic s v1 v2 : Atomic s (FAA (Val v1) (Val v2)).
-Proof. solve_atomic. Qed.
-
-Local Ltac solve_exec_safe := intros; subst; do 3 eexists; econstructor; eauto.
-Local Ltac solve_exec_puredet := simpl; intros; by inv_head_step.
-Local Ltac solve_pure_exec :=
-  subst; intros ?; apply nsteps_once, pure_head_step_pure_step;
-    constructor; [solve_exec_safe | solve_exec_puredet].
-
-(** The behavior of the various [wp_] tactics with regard to lambda differs in
-the following way:
-
-- [wp_pures] does *not* reduce lambdas/recs that are hidden behind a definition.
-- [wp_rec] and [wp_lam] reduce lambdas/recs that are hidden behind a definition.
-
-To realize this behavior, we define the class [AsRecV v f x erec], which takes a
-value [v] as its input, and turns it into a [RecV f x erec] via the instance
-[AsRecV_recv : AsRecV (RecV f x e) f x e]. We register this instance via
-[Hint Extern] so that it is only used if [v] is syntactically a lambda/rec, and
-not if [v] contains a lambda/rec that is hidden behind a definition.
-
-To make sure that [wp_rec] and [wp_lam] do reduce lambdas/recs that are hidden
-behind a definition, we activate [AsRecV_recv] by hand in these tactics. *)
-Class AsRecV (v : val) (f x : binder) (erec : expr) :=
-  as_recv : v = RecV f x erec.
-#[global] Hint Mode AsRecV ! - - - : typeclass_instances.
-Definition AsRecV_recv f x e : AsRecV (RecV f x e) f x e := eq_refl.
-#[global] Hint Extern 0 (AsRecV (RecV _ _ _) _ _ _) =>
-  apply AsRecV_recv : typeclass_instances.
-
-#[global] Instance pure_recc f x (erec : expr) :
-  PureExec True 1 (Rec f x erec) (Val $ RecV f x erec).
-Proof. solve_pure_exec. Qed.
-#[global] Instance pure_pairc (v1 v2 : val) :
-  PureExec True 1 (Pair (Val v1) (Val v2)) (Val $ PairV v1 v2).
-Proof. solve_pure_exec. Qed.
-#[global] Instance pure_injlc (v : val) :
-  PureExec True 1 (InjL $ Val v) (Val $ InjLV v).
-Proof. solve_pure_exec. Qed.
-#[global] Instance pure_injrc (v : val) :
-  PureExec True 1 (InjR $ Val v) (Val $ InjRV v).
-Proof. solve_pure_exec. Qed.
-
-#[global] Instance pure_beta f x (erec : expr) (v1 v2 : val) `{!AsRecV v1 f x erec} :
-  PureExec True 1 (App (Val v1) (Val v2)) (subst' x v2 (subst' f v1 erec)).
-Proof. unfold AsRecV in *. solve_pure_exec. Qed.
-
-#[global] Instance pure_unop op v v' :
-  PureExec (un_op_eval op v = Some v') 1 (UnOp op (Val v)) (Val v').
-Proof. solve_pure_exec. Qed.
-
-#[global] Instance pure_binop op v1 v2 v' :
-  PureExec (bin_op_eval op v1 v2 = Some v') 1 (BinOp op (Val v1) (Val v2)) (Val v') | 10.
-Proof. solve_pure_exec. Qed.
-(* Higher-priority instance for [EqOp]. *)
-#[global] Instance pure_eqop v1 v2 :
-  PureExec (vals_compare_safe v1 v2) 1
-    (BinOp EqOp (Val v1) (Val v2))
-    (Val $ LitV $ LitBool $ bool_decide (v1 = v2)) | 1.
-Proof.
-  intros Hcompare.
-  cut (bin_op_eval EqOp v1 v2 = Some $ LitV $ LitBool $ bool_decide (v1 = v2)).
-  { intros. revert Hcompare. solve_pure_exec. }
-  rewrite /bin_op_eval /= decide_True //.
-Qed.
-
-#[global] Instance pure_if_true e1 e2 : PureExec True 1 (If (Val $ LitV $ LitBool true) e1 e2) e1.
-Proof. solve_pure_exec. Qed.
-
-#[global] Instance pure_if_false e1 e2 : PureExec True 1 (If (Val $ LitV  $ LitBool false) e1 e2) e2.
-Proof. solve_pure_exec. Qed.
-
-#[global] Instance pure_fst v1 v2 :
-  PureExec True 1 (Fst (Val $ PairV v1 v2)) (Val v1).
-Proof. solve_pure_exec. Qed.
-
-#[global] Instance pure_snd v1 v2 :
-  PureExec True 1 (Snd (Val $ PairV v1 v2)) (Val v2).
-Proof. solve_pure_exec. Qed.
-
-#[global] Instance pure_case_inl v e1 e2 :
-  PureExec True 1 (Case (Val $ InjLV v) e1 e2) (App e1 (Val v)).
-Proof. solve_pure_exec. Qed.
-
-#[global] Instance pure_case_inr v e1 e2 :
-  PureExec True 1 (Case (Val $ InjRV v) e1 e2) (App e2 (Val v)).
-Proof. solve_pure_exec. Qed.
-
-Section lifting.
-Context `{LM:LiveModel heap_lang M}.
-Context `{!heapGS Σ LM}.
-Implicit Types P Q : iProp Σ.
-Implicit Types Φ : val → iProp Σ.
-Implicit Types efs : list expr.
-Implicit Types σ : state.
-Implicit Types v : val.
-Implicit Types l : loc.
-Implicit Types tid : nat.
-
-Definition sswp (s : stuckness) E e1 (Φ : expr → iProp Σ) : iProp Σ :=
-  match to_val e1 with
-  | Some v => |={E}=> (Φ (of_val v))
-  | None => ∀ σ1,
-      gen_heap_interp σ1.(heap) ={E,∅}=∗
-       ⌜if s is NotStuck then reducible e1 σ1 else True⌝ ∗
-       ∀ e2 σ2 efs,
-         ⌜prim_step e1 σ1 e2 σ2 efs⌝ ={∅}▷=∗ |={∅,E}=>
-         gen_heap_interp σ2.(heap) ∗ Φ e2 ∗ ⌜efs = []⌝
-  end%I.
-
-Lemma sswp_wand s e E (Φ Ψ : expr → iProp Σ) :
-  (∀ e, Φ e -∗ Ψ e) -∗ sswp s E e Φ -∗ sswp s E e Ψ.
-Proof.
-  rewrite /sswp. iIntros "HΦΨ HΦ".
-  destruct (to_val e); [by iApply "HΦΨ"|].
-  iIntros (?) "H". iMod ("HΦ" with "H") as "[%Hs HΦ]".
-  iModIntro. iSplit; [done|]. iIntros (????).
-  iDestruct ("HΦ" with "[//]") as "HΦ".
-  iMod "HΦ". iIntros "!>!>". iMod "HΦ". iIntros "!>". iMod "HΦ" as "(?&?&?)".
-  iIntros "!>". iFrame. by iApply "HΦΨ".
-Qed.
-
-Lemma has_fuels_decr E tid fs :
-  tid ↦M++ fs -∗ |~{E}~| tid ↦M fs.
-Proof.
-  iIntros "Hf". rewrite weakestpre.pre_step_unseal.
-  iIntros (extr atr) "[%Hvse [Hσ Hm]]".
-  iMod (model_state_interp_has_fuels_decr with "Hm Hf") as "[$ $]". by iFrame.
-Qed.
-
-Lemma has_fuels_dealloc E tid fs ρ δ :
-  ρ ∉ live_roles _ δ → frag_model_is δ -∗ tid ↦M fs -∗
-  |~{E}~| frag_model_is δ ∗ tid ↦M (delete ρ fs).
-Proof.
-  iIntros (Hnin) "Hst Hf". rewrite weakestpre.pre_step_unseal.
-  iIntros (extr atr) "[%Hvse [Hσ Hm]]".
-  iMod (model_state_interp_has_fuels_dealloc with "Hm Hst Hf") as "[Hm Hf]";
-    [done|by iFrame].
-Qed.
-
-(* Rule from the Trillium article *)
-Lemma wp_role_dealloc s tid E e fs ρ δ Φ :
-  ρ ∉ live_roles _ δ → frag_model_is δ -∗ tid ↦M fs -∗
-  (frag_model_is δ -∗ tid ↦M (delete ρ fs) -∗ WP e @ s; tid; E {{ Φ }}) -∗
-  WP e @ s; tid; E {{ Φ }}.
-Proof.
-  iIntros (Hnin) "HM Hfuels Hwp".
-  iMod (has_fuels_dealloc with "HM Hfuels") as "[HM Hfuels]"; [done|].
-  by iApply ("Hwp" with "HM Hfuels").
-Qed.
-
-Lemma wp_step_model s tid ρ (f1 : nat) fs fr s1 s2 E e Φ :
-  TCEq (to_val e) None →
-  fmtrans M s1 (Some ρ) s2 →
-  M.(live_roles) s2 ⊆ M.(live_roles) s1 →
-  ρ ∉ dom fs →
-  ▷ frag_model_is s1 -∗
-  ▷ tid ↦M ({[ρ:=f1]} ∪ fmap S fs) -∗
-  ▷ frag_free_roles_are fr -∗
-  sswp s E e (λ e', frag_model_is s2 -∗
-                    tid ↦M ({[ρ:=(LM.(lm_fl) s2)]} ∪ fs) -∗
-                    frag_free_roles_are fr -∗
-                    WP e' @ s; tid; E {{ Φ }} ) -∗
-  WP e @ s; tid; E {{ Φ }}.
-Proof.
-  iIntros (Hval Htrans Hlive Hdom) ">Hst >Hfuel1 >Hfr Hwp".
-  rewrite wp_unfold /wp_pre.
-  rewrite /sswp. simpl. rewrite Hval.
-  iIntros (extr atr K tp1 tp2 σ1 Hvalid Hloc Hexend) "(% & Hsi & Hmi)".
-  iMod ("Hwp" with "Hsi") as (Hred) "Hwp". iIntros "!>".
-  iSplitR; [by rewrite Hexend in Hred|]. iIntros (????). rewrite Hexend.
-  iMod ("Hwp" with "[//]") as "Hwp". iIntros "!>!>". iMod "Hwp". iIntros "!>".
-  iApply step_fupdN_intro; [done|]. iIntros "!>".
-  iMod "Hwp" as "[Hσ [Hwp ->]]".
-  iDestruct (model_agree' with "Hmi Hst") as %Hmeq. iFrame.
-  rewrite /trace_ends_in in Hexend. rewrite -Hexend.
-  iMod (update_model_step with "Hfuel1 Hst Hmi") as
-    (δ2 Hvse) "(Hfuel & Hst & Hmod)"; eauto.
-  - rewrite -Hloc. eapply locale_step_atomic; eauto. by apply fill_step.
-  - iModIntro; iExists δ2, (Take_step ρ tid). rewrite big_sepL_nil. iFrame.
-    iSplit; [done|]. iDestruct ("Hwp" with "Hst Hfuel Hfr") as "Hwp". by iFrame.
-Qed.
-
-Lemma wp_step_model_singlerole s tid ρ (f1 : nat) fr s1 s2 E e Φ :
-  TCEq (to_val e) None →
-  fmtrans M s1 (Some ρ) s2 →
-  M.(live_roles) s2 ⊆ M.(live_roles) s1 →
-  ▷ frag_model_is s1 -∗ ▷ tid ↦M {[ρ := f1]} -∗ ▷ frag_free_roles_are fr -∗
-  sswp s E e (λ e', frag_model_is s2 -∗
-                    tid ↦M {[ρ := (LM.(lm_fl) s2)]} -∗
-                    frag_free_roles_are fr -∗
-                    WP e' @ s; tid; E {{ Φ }} ) -∗
-  WP e @ s; tid; E {{ Φ }}.
-Proof.
-  iIntros (Hval Htrans Hlive) ">Hst >Hfuel1 >Hfr Hwp".
-  replace ({[ρ := f1]}) with ({[ρ := f1]} ∪ (fmap S ∅:gmap _ _)); last first.
-  { rewrite fmap_empty. rewrite right_id_L. done. }
-  iApply (wp_step_model with "Hst Hfuel1 Hfr"); [done|set_solver|done|].
-  iApply (sswp_wand with "[] Hwp"). iIntros (e') "Hwp Hst Hfuel1 Hfr".
-  rewrite right_id_L. iApply ("Hwp" with "Hst Hfuel1 Hfr").
-Qed.
-
-Lemma wp_step_fuel s tid E e fs Φ :
-  fs ≠ ∅ → ▷ tid ↦M++ fs -∗
-  sswp s E e (λ e', tid ↦M fs -∗ WP e' @ s; tid; E {{ Φ }} ) -∗
-  WP e @ s; tid; E {{ Φ }}.
-Proof.
-  iIntros (?) ">HfuelS Hwp". rewrite wp_unfold /wp_pre /sswp /=.
-  destruct (to_val e).
-  { iMod (has_fuels_decr with "HfuelS") as "Hfuel".
-    iDestruct ("Hwp" with "Hfuel") as "Hwp".
-    iDestruct (wp_value_inv with "Hwp") as "Hwp". by iMod "Hwp". }
-  iIntros (extr atr K tp1 tp2 σ1 Hvalid Hloc Hends) "(%Hvalid' & Hsi & Hmi)".
-  rewrite Hends. iMod ("Hwp" with "Hsi") as (Hred) "Hwp". iModIntro.
-  iSplit; [done|]. iIntros (e2 σ2 efs Hstep).
-  iMod ("Hwp" with "[//]") as "Hwp".
-  iIntros "!>!>". iMod "Hwp". iIntros "!>".
-  iApply step_fupdN_intro; [done|]. iIntros "!>". iMod "Hwp". rewrite -Hends.
-  iMod (update_fuel_step with "HfuelS Hmi") as (δ2) "(%Hvse & Hfuel & Hmod)" =>//.
-  { rewrite Hends -Hloc. eapply locale_step_atomic; eauto. by apply fill_step. }
-  iIntros "!>". iDestruct "Hwp" as "[Hsi [Hwp ->]]".
-  iExists _, (Silent_step tid). iFrame. iSplit; [done|].
-  iDestruct ("Hwp" with "Hfuel") as "Hwp". iSplit; [|done].
-  iApply (wp_wand with "Hwp"). iIntros (v) "HΦ'". by iFrame.
-Qed.
-
-(* TODO: Move this somewhere else *)
-Lemma heap_lang_locales_equiv_from_length (es10 es1 es20 es2 : list expr) :
-  length es10 = length es20 → length es1 = length es2 →
-  locales_equiv_from es10 es20 es1 es2.
-Proof.
-  revert es10 es20 es2.
-  induction es1 as [|e es1 IHes1]; intros es10 es20 es2 Hlen; [by destruct es2|].
-  destruct es2; [done|]=> /=. constructor; [done|].
-  apply IHes1; [by rewrite !app_length=> /=;f_equiv|lia].
-Qed.
-
-Lemma heap_lang_locales_equiv_length (es1 es2 : list expr) :
-  length es1 = length es2 → locales_equiv es1 es2.
-Proof. intros Hlen. by apply heap_lang_locales_equiv_from_length. Qed.  
-
-Lemma wp_role_fork s tid E e Φ R1 R2 (Hdisj: R1 ##ₘ R2) (Hnemp: R1 ∪ R2 ≠ ∅):
-  tid ↦M++ (R1 ∪ R2) -∗
-  (∀ tid', ▷ (tid' ↦M R2 -∗ WP e @ s; tid'; ⊤ {{ _, tid' ↦M ∅ }})) -∗
-  ▷ (tid ↦M R1 ={E}=∗ Φ (LitV LitUnit)) -∗
-  WP Fork e @ s; tid; E {{ Φ }}.
-Proof.
-  iIntros "Htid He HΦ". iApply wp_lift_atomic_head_step; [done|].
-  iIntros (extr auxtr K tp1 tp2 σ1 Hvalex Hexend Hloc) "(% & Hsi & Hmi)".
-  iMod (update_fork_step R1 R2 _
-       (tp1 ++ ectx_language.fill K (Val $ LitV LitUnit) :: tp2 ++ [e])
-       _ _ _ e _ σ1 with "Htid Hmi") as
-    (δ2 Hvse) "(Hfuels1 & Hfuels2 & Hmi)".
-  { done. }
-  { done. }
-  { rewrite /trace_ends_in in Hexend. rewrite Hexend. done. }
-  { rewrite -Hloc. rewrite -(language.locale_fill _ _ K).
-    rewrite /trace_ends_in in Hexend. rewrite Hexend.
-    econstructor 1 =>//.
-    apply fill_step, head_prim_step. econstructor. }
-  { list_simplifier. exists (tp1 ++ fill K #() :: tp2).
-    rewrite /trace_ends_in in Hexend. rewrite Hexend.
-    split; first by list_simplifier.
-    apply heap_lang_locales_equiv_length. simpl.
-    rewrite !app_length //=. }
-  iModIntro. iSplit. iPureIntro; first by eauto. iNext.
-  iIntros (e2 σ2 efs Hstep).
-  have [-> [-> ->]] : σ2 = σ1 ∧ efs = [e] ∧ e2 = Val $ LitV LitUnit by inv_head_step.
-  iMod ("HΦ" with "Hfuels1") as "HΦ". iModIntro. iExists δ2, (Silent_step tid).
-  iFrame. rewrite Hexend /=. iFrame "Hsi". iSplit; [by iPureIntro|].
-  iSplit; [|done]. iApply "He". by list_simplifier.
-Qed.
-
-Lemma sswp_pure_step s E e1 e2 (Φ : Prop) Ψ :
-  PureExec Φ 1 e1 e2 → Φ → ▷ Ψ e2 -∗ sswp s E e1 Ψ%I.
-Proof.
-  iIntros (Hpe HΦ) "HΨ".
-  assert (pure_step e1 e2) as Hps.
-  { specialize (Hpe HΦ). by apply nsteps_once_inv in Hpe. }
-  rewrite /sswp /=.
-  assert (to_val e1 = None) as ->.
-  { destruct Hps as [Hred _]. specialize (Hred (Build_state ∅ ∅)).
-    by eapply reducible_not_val. }
-  iIntros (σ) "Hσ".
-  iMod fupd_mask_subseteq as "Hclose"; last iModIntro; [by set_solver|].
-  iSplit.
-  { destruct s; [|done]. by destruct Hps as [Hred _]. }
-  iIntros (e2' σ2 efs Hstep) "!>!>!>".
-  iMod "Hclose". iModIntro. destruct Hps as [_ Hstep'].
-  apply Hstep' in Hstep as [-> [-> ->]]. by iFrame.
-Qed.
-
-(** Heap *)
-(** The usable rules for [allocN] stated in terms of the [array] proposition
-are derived in te file [array]. *)
-Lemma heap_array_to_seq_meta l vs (n : nat) :
-  length vs = n →
-  ([∗ map] l' ↦ _ ∈ heap_array l vs, meta_token l' ⊤) -∗
-  [∗ list] i ∈ seq 0 n, meta_token (l +ₗ (i : nat)) ⊤.
-Proof.
-  iIntros (<-) "Hvs". iInduction vs as [|v vs] "IH" forall (l)=> //=.
-  rewrite big_opM_union; last first.
-  { apply map_disjoint_spec=> l' v1 v2 /lookup_singleton_Some [-> _].
-    intros (j&?&Hjl&_)%heap_array_lookup.
-    rewrite loc_add_assoc -{1}[l']loc_add_0 in Hjl. simplify_eq; lia. }
-  rewrite loc_add_0 -fmap_S_seq big_sepL_fmap.
-  setoid_rewrite Nat2Z.inj_succ. setoid_rewrite <-Z.add_1_l.
-  setoid_rewrite <-loc_add_assoc.
-  rewrite big_opM_singleton; iDestruct "Hvs" as "[$ Hvs]". by iApply "IH".
-Qed.
-
-Lemma heap_array_to_seq_mapsto l v (n : nat) :
-  ([∗ map] l' ↦ v ∈ heap_array l (replicate n v), l' ↦ v) -∗
-  [∗ list] i ∈ seq 0 n, (l +ₗ (i : nat)) ↦ v.
-Proof.
-  iIntros "Hvs". iInduction n as [|n] "IH" forall (l); simpl.
-  { done. }
-  rewrite big_opM_union; last first.
-  { apply map_disjoint_spec=> l' v1 v2 /lookup_singleton_Some [-> _].
-    intros (j&?&Hjl&_)%heap_array_lookup.
-    rewrite loc_add_assoc -{1}[l']loc_add_0 in Hjl. simplify_eq; lia. }
-  rewrite loc_add_0 -fmap_S_seq big_sepL_fmap.
-  setoid_rewrite Nat2Z.inj_succ. setoid_rewrite <-Z.add_1_l.
-  setoid_rewrite <-loc_add_assoc.
-  rewrite big_opM_singleton; iDestruct "Hvs" as "[$ Hvs]". by iApply "IH".
-Qed.
-
-Lemma wp_allocN_seq s E v n (Φ : expr → iProp Σ) :
-  0 < n →
-  ▷ (∀ (l:loc), ([∗ list] i ∈ seq 0 (Z.to_nat n),
-                 (l +ₗ (i : nat)) ↦ v ∗ meta_token (l +ₗ (i : nat)) ⊤) -∗ Φ #l) -∗
-  sswp s E (AllocN (Val $ LitV $ LitInt $ n) (Val v)) Φ.
-Proof.
-  iIntros (HnO) "HΦ".
-  rewrite /sswp. simpl.
-  iIntros (σ) "Hσ".
-  iMod fupd_mask_subseteq as "Hclose"; last iModIntro; first by set_solver.
-  iSplit.
-  { iPureIntro. destruct s; [|done]. apply head_prim_reducible. eauto. }
-  iIntros (e2 σ2 efs Hstep). iIntros "!>!>!>".
-  iMod "Hclose".
-  apply head_reducible_prim_step in Hstep; [|eauto].
-  inv_head_step.
-  iMod (gen_heap_alloc_big _ (heap_array l (replicate (Z.to_nat n) v)) with "Hσ")
-    as "(Hσ & Hl & Hm)".
-  { apply heap_array_map_disjoint.
-    rewrite replicate_length Z2Nat.id ?Hexend; auto with lia. }
-  iFrame.
-  iModIntro.
-  iSplit; [|done].
-  iApply "HΦ".
-  iApply big_sepL_sep. iSplitL "Hl".
-  + by iApply heap_array_to_seq_mapsto.
-  + iApply (heap_array_to_seq_meta with "Hm"). by rewrite replicate_length.
-Qed.
-
-Lemma wp_alloc s E v (Φ : expr → iProp Σ) :
-  ▷ (∀ l, l ↦ v -∗ meta_token l ⊤ -∗ Φ (LitV (LitLoc l))) -∗
-  sswp s E (Alloc v) Φ.
-Proof.
-  iIntros "HΦ". iApply wp_allocN_seq; [lia|].
-  iIntros "!>" (l) "[[Hl Hm] _]". rewrite loc_add_0.
-  iApply ("HΦ" with "Hl Hm").
-Qed.
-
-Lemma wp_choose_nat s E (Φ : expr → iProp Σ) :
-  ▷ (∀ (n:nat), Φ $ Val $ LitV (LitInt n)) -∗
-  sswp s E ChooseNat Φ.
-Proof.
-  iIntros "HΦ".
-  rewrite /sswp. simpl.
-  iIntros (σ) "Hσ".
-  iMod fupd_mask_subseteq as "Hclose"; last iModIntro; first by set_solver.
-  iSplit.
-  { iPureIntro. destruct s; [|done]. apply head_prim_reducible. eauto. }
-  iIntros (e2 σ2 efs Hstep). iIntros "!>!>!>".
-  iMod "Hclose".
-  apply head_reducible_prim_step in Hstep; [|eauto].
-  inv_head_step.
-  iFrame.
-  iModIntro.
-  iSplit; [|done].
-  iApply "HΦ".
-  Unshelve. all: apply O.
-Qed.
-
-Lemma wp_load s E l q v (Φ : expr → iProp Σ) :
-  ▷ l ↦{q} v -∗
-  ▷ (l ↦{q} v -∗ Φ v) -∗
-  sswp s E (Load (Val $ LitV $ LitLoc l)) Φ.
-Proof.
-  iIntros ">Hl HΦ".
-  rewrite /sswp. simpl.
-  iIntros (σ) "Hσ".
-  iMod fupd_mask_subseteq as "Hclose"; last iModIntro; first by set_solver.
-  iDestruct (@gen_heap_valid with "Hσ Hl") as %Hheap.
-  iSplit.
-  { iPureIntro. destruct s; [|done]. apply head_prim_reducible. eauto. }
-  iIntros (e2 σ2 efs Hstep). iIntros "!>!>!>".
-  iMod "Hclose".
-  apply head_reducible_prim_step in Hstep; [|eauto].
-  inv_head_step.
-  iFrame.
-  iModIntro.
-  iSplit; [|done].
-  by iApply "HΦ".
-Qed.
-
-Lemma wp_store s E l v' v (Φ : expr → iProp Σ) :
-  ▷ l ↦ v' -∗
-  ▷ (l ↦ v -∗ Φ $ LitV LitUnit) -∗
-  sswp s E (Store (Val $ LitV (LitLoc l)) (Val v)) Φ.
-Proof.
-  iIntros ">Hl HΦ". simpl.
-  iIntros (σ1) "Hsi".
-  iDestruct (gen_heap_valid with "Hsi Hl") as %Hheap.
-  iApply fupd_mask_intro; [set_solver|]. iIntros "Hclose".
-  iSplit.
-  { destruct s; [|done]. iPureIntro. apply head_prim_reducible. by eauto. }
-  iIntros (e2 σ2 efs Hstep). iIntros "!>!>!>".
-  iMod "Hclose".
-  iMod (@gen_heap_update with "Hsi Hl") as "[Hsi Hl]".
-  iFrame.
-  apply head_reducible_prim_step in Hstep; [|by eauto].
-  inv_head_step. iFrame. iModIntro. iSplit; [|done]. by iApply "HΦ".
-Qed.
-
-Lemma wp_cmpxchg_fail s E l q v' v1 v2 (Φ : expr → iProp Σ) :
-  v' ≠ v1 → vals_compare_safe v' v1 →
-  ▷ l ↦{q} v' -∗
-  ▷ (l ↦{q} v' -∗ Φ $ PairV v' (LitV $ LitBool false)) -∗
-  sswp s E (CmpXchg (Val $ LitV $ LitLoc l) (Val v1) (Val v2)) Φ.
-Proof.
-  iIntros (??) ">Hl HΦ". simpl.
-  iIntros (σ1) "Hsi".
-  iDestruct (gen_heap_valid with "Hsi Hl") as %Hheap.
-  iApply fupd_mask_intro; [set_solver|]. iIntros "Hclose".
-  iSplit.
-  { destruct s; [|done]. iPureIntro. apply head_prim_reducible. by eauto. }
-  iIntros (e2 σ2 efs Hstep). iIntros "!>!>!>".
-  iMod "Hclose".
-  iFrame.
-  apply head_reducible_prim_step in Hstep; [|by eauto].
-  inv_head_step.
-  rewrite bool_decide_false //. iFrame. iModIntro.
-  iSplit; [|done].
-  by iApply "HΦ".
-Qed.
-
-Lemma wp_cmpxchg_suc s E l v' v1 v2 (Φ : expr → iProp Σ) :
-  v' = v1 → vals_compare_safe v' v1 →
-  ▷ l ↦ v' -∗
-  ▷ (l ↦ v2 -∗ Φ $ PairV v' (LitV $ LitBool true)) -∗
-  sswp s E (CmpXchg (Val $ LitV $ LitLoc l) (Val v1) (Val v2)) Φ.
-Proof.
-  iIntros (??) ">Hl HΦ". simpl.
-  iIntros (σ1) "Hsi".
-  iDestruct (gen_heap_valid with "Hsi Hl") as %Hheap.
-  iApply fupd_mask_intro; [set_solver|]. iIntros "Hclose".
-  iSplit.
-  { destruct s; [|done]. iPureIntro. apply head_prim_reducible. by eauto. }
-  iIntros (e2 σ2 efs Hstep). iIntros "!>!>!>".
-  iMod (@gen_heap_update with "Hsi Hl") as "[Hsi Hl]".
-  iMod "Hclose".
-  iFrame.
-  apply head_reducible_prim_step in Hstep; [|by eauto].
-  inv_head_step.
-  rewrite bool_decide_true //. iFrame. iModIntro.
-  iSplit; [|done].
-  by iApply "HΦ".
-Qed.
-
-End lifting.
diff --git a/fairis/heap_lang_lm.v b/fairis/heap_lang_lm.v
new file mode 100644
index 0000000..27aced8
--- /dev/null
+++ b/fairis/heap_lang_lm.v
@@ -0,0 +1,37 @@
+From iris.base_logic Require Export gen_heap.
+From iris.proofmode Require Import tactics.
+From trillium.program_logic Require Export weakestpre.
+(* From fairness Require Import fairness. *)
+From fairis Require Import fuel resources.
+From heap_lang Require Export lang tactics notation heap_lang_defs.
+
+
+Class heapGpreS Σ `(LM: LiveModel heap_lang M) := HeapPreG {
+  heapGpreS_inv :: invGpreS Σ;
+  heapGpreS_gen_heap :: heap1GpreS Σ;
+  heapGpreS_fairness :: fairnessGpreS LM Σ;
+}.
+
+Class heapGS Σ `(LM:LiveModel heap_lang M) := HeapG {
+  heap_inG :: heapGpreS Σ LM;
+  heap_invGS : invGS_gen HasNoLc Σ;
+  heap_gen_heapGS :: heap1GS Σ;
+  heap_fairnessGS :: fairnessGS LM Σ;
+}.
+
+Definition heapΣ (M : FairModel) : gFunctors :=
+  #[ invΣ; heap1Σ; fairnessΣ heap_lang M ].
+
+Global Instance subG_heapPreG {Σ} `{LM : LiveModel heap_lang M} :
+  subG (heapΣ M) Σ → heapGpreS Σ LM.
+Proof. solve_inG. Qed.
+
+
+#[global] Instance heapG_irisG `{LM:LiveModel heap_lang M} `{!heapGS Σ LM} : irisG heap_lang LM Σ := {
+    iris_invGS := heap_invGS;
+    state_interp extr auxtr :=
+      (⌜valid_state_evolution_fairness extr auxtr⌝ ∗
+       gen_heap_interp (trace_last extr).2.(heap) ∗
+       model_state_interp (trace_last extr).1 (trace_last auxtr))%I ;
+    fork_post tid := λ _, (tid ↦M ∅)%I;
+}.
diff --git a/fairis/lifting.v b/fairis/lifting.v
new file mode 100644
index 0000000..de6a0f4
--- /dev/null
+++ b/fairis/lifting.v
@@ -0,0 +1,160 @@
+From stdpp Require Import fin_maps.
+From iris.proofmode Require Import tactics.
+From iris.algebra Require Import auth gmap gset excl.
+From iris.base_logic Require Export gen_heap.
+From trillium.prelude Require Import classical_instances.
+From trillium.program_logic Require Export ectx_lifting.
+From heap_lang Require Export sswp_logic locales_helpers_hl.
+From fairis Require Export fuel resources heap_lang_lm
+  (* fair_termination fuel fuel_termination *)
+.
+(* From trillium.program_logic Require Import ectx_lifting. *)
+(* From trillium.fairness.heap_lang Require Export lang. *)
+(* From trillium.fairness.heap_lang Require Import tactics notation. *)
+
+Set Default Proof Using "Type".
+
+(* Canonical Structure ModelO (M : FairModel) := leibnizO M. *)
+(* Canonical Structure RoleO (M : FairModel) := leibnizO (M.(fmrole)). *)
+
+Section lifting.
+Context `{LM:LiveModel heap_lang M}.
+Context `{!heapGS Σ LM}.
+
+Lemma has_fuels_decr E tid fs :
+  tid ↦M++ fs -∗ |~{E}~| tid ↦M fs.
+Proof.
+  iIntros "Hf". rewrite weakestpre.pre_step_unseal.
+  iIntros (extr atr) "[%Hvse [Hσ Hm]]".
+  iMod (model_state_interp_has_fuels_decr with "Hm Hf") as "[$ $]". by iFrame.
+Qed.
+
+Lemma has_fuels_dealloc E tid fs ρ δ :
+  ρ ∉ live_roles _ δ → frag_model_is δ -∗ tid ↦M fs -∗
+  |~{E}~| frag_model_is δ ∗ tid ↦M (delete ρ fs).
+Proof.
+  iIntros (Hnin) "Hst Hf". rewrite weakestpre.pre_step_unseal.
+  iIntros (extr atr) "[%Hvse [Hσ Hm]]".
+  iMod (model_state_interp_has_fuels_dealloc with "Hm Hst Hf") as "[Hm Hf]";
+    [done|by iFrame].
+Qed.
+
+(* Rule from the Trillium article *)
+Lemma wp_role_dealloc s tid E e fs ρ δ Φ :
+  ρ ∉ live_roles _ δ → frag_model_is δ -∗ tid ↦M fs -∗
+  (frag_model_is δ -∗ tid ↦M (delete ρ fs) -∗ WP e @ s; tid; E {{ Φ }}) -∗
+  WP e @ s; tid; E {{ Φ }}.
+Proof.
+  iIntros (Hnin) "HM Hfuels Hwp".
+  iMod (has_fuels_dealloc with "HM Hfuels") as "[HM Hfuels]"; [done|].
+  by iApply ("Hwp" with "HM Hfuels").
+Qed.
+
+Lemma wp_step_model s tid ρ (f1 : nat) fs fr s1 s2 E e Φ :
+  TCEq (to_val e) None →
+  fmtrans M s1 (Some ρ) s2 →
+  M.(live_roles) s2 ⊆ M.(live_roles) s1 →
+  ρ ∉ dom fs →
+  ▷ frag_model_is s1 -∗
+  ▷ tid ↦M ({[ρ:=f1]} ∪ fmap S fs) -∗
+  ▷ frag_free_roles_are fr -∗
+  sswp s E e (λ e', frag_model_is s2 -∗
+                    tid ↦M ({[ρ:=(LM.(lm_fl) s2)]} ∪ fs) -∗
+                    frag_free_roles_are fr -∗
+                    WP e' @ s; tid; E {{ Φ }} ) -∗
+  WP e @ s; tid; E {{ Φ }}.
+Proof.
+  iIntros (Hval Htrans Hlive Hdom) ">Hst >Hfuel1 >Hfr Hwp".
+  rewrite wp_unfold /wp_pre.
+  rewrite /sswp. simpl. rewrite Hval.
+  iIntros (extr atr K tp1 tp2 σ1 Hvalid Hloc Hexend) "(% & Hsi & Hmi)".
+  iMod ("Hwp" with "Hsi") as (Hred) "Hwp". iIntros "!>".
+  iSplitR; [by rewrite Hexend in Hred|]. iIntros (????). rewrite Hexend.
+  iMod ("Hwp" with "[//]") as "Hwp". iIntros "!>!>". iMod "Hwp". iIntros "!>".
+  iApply step_fupdN_intro; [done|]. iIntros "!>".
+  iMod "Hwp" as "[Hσ [Hwp ->]]".
+  iDestruct (model_agree' with "Hmi Hst") as %Hmeq. iFrame.
+  rewrite /trace_ends_in in Hexend. rewrite -Hexend.
+  iMod (update_model_step with "Hfuel1 Hst Hmi") as
+    (δ2 Hvse) "(Hfuel & Hst & Hmod)"; eauto.
+  - rewrite -Hloc. eapply locale_step_atomic; eauto. by apply fill_step.
+  - iModIntro; iExists δ2, (Take_step ρ tid). rewrite big_sepL_nil. iFrame.
+    iSplit; [done|]. iDestruct ("Hwp" with "Hst Hfuel Hfr") as "Hwp". by iFrame.
+Qed.
+
+Lemma wp_step_model_singlerole s tid ρ (f1 : nat) fr s1 s2 E e Φ :
+  TCEq (to_val e) None →
+  fmtrans M s1 (Some ρ) s2 →
+  M.(live_roles) s2 ⊆ M.(live_roles) s1 →
+  ▷ frag_model_is s1 -∗ ▷ tid ↦M {[ρ := f1]} -∗ ▷ frag_free_roles_are fr -∗
+  sswp s E e (λ e', frag_model_is s2 -∗
+                    tid ↦M {[ρ := (LM.(lm_fl) s2)]} -∗
+                    frag_free_roles_are fr -∗
+                    WP e' @ s; tid; E {{ Φ }} ) -∗
+  WP e @ s; tid; E {{ Φ }}.
+Proof.
+  iIntros (Hval Htrans Hlive) ">Hst >Hfuel1 >Hfr Hwp".
+  replace ({[ρ := f1]}) with ({[ρ := f1]} ∪ (fmap S ∅:gmap _ _)); last first.
+  { rewrite fmap_empty. rewrite right_id_L. done. }
+  iApply (wp_step_model with "Hst Hfuel1 Hfr"); [done|set_solver|done|].
+  iApply (sswp_wand with "[] Hwp"). iIntros (e') "Hwp Hst Hfuel1 Hfr".
+  rewrite right_id_L. iApply ("Hwp" with "Hst Hfuel1 Hfr").
+Qed.
+
+Lemma wp_step_fuel s tid E e fs Φ :
+  fs ≠ ∅ → ▷ tid ↦M++ fs -∗
+  sswp s E e (λ e', tid ↦M fs -∗ WP e' @ s; tid; E {{ Φ }} ) -∗
+  WP e @ s; tid; E {{ Φ }}.
+Proof.
+  iIntros (?) ">HfuelS Hwp". rewrite wp_unfold /wp_pre /sswp /=.
+  destruct (to_val e).
+  { iMod (has_fuels_decr with "HfuelS") as "Hfuel".
+    iDestruct ("Hwp" with "Hfuel") as "Hwp".
+    iDestruct (wp_value_inv with "Hwp") as "Hwp". by iMod "Hwp". }
+  iIntros (extr atr K tp1 tp2 σ1 Hvalid Hloc Hends) "(%Hvalid' & Hsi & Hmi)".
+  rewrite Hends. iMod ("Hwp" with "Hsi") as (Hred) "Hwp". iModIntro.
+  iSplit; [done|]. iIntros (e2 σ2 efs Hstep).
+  iMod ("Hwp" with "[//]") as "Hwp".
+  iIntros "!>!>". iMod "Hwp". iIntros "!>".
+  iApply step_fupdN_intro; [done|]. iIntros "!>". iMod "Hwp". rewrite -Hends.
+  iMod (update_fuel_step with "HfuelS Hmi") as (δ2) "(%Hvse & Hfuel & Hmod)" =>//.
+  { rewrite Hends -Hloc. eapply locale_step_atomic; eauto. by apply fill_step. }
+  iIntros "!>". iDestruct "Hwp" as "[Hsi [Hwp ->]]".
+  iExists _, (Silent_step tid). iFrame. iSplit; [done|].
+  iDestruct ("Hwp" with "Hfuel") as "Hwp". iSplit; [|done].
+  iApply (wp_wand with "Hwp"). iIntros (v) "HΦ'". by iFrame.
+Qed.
+
+Lemma wp_role_fork s tid E e Φ R1 R2 (Hdisj: R1 ##ₘ R2) (Hnemp: R1 ∪ R2 ≠ ∅):
+  tid ↦M++ (R1 ∪ R2) -∗
+  (∀ tid', ▷ (tid' ↦M R2 -∗ WP e @ s; tid'; ⊤ {{ _, tid' ↦M ∅ }})) -∗
+  ▷ (tid ↦M R1 ={E}=∗ Φ (LitV LitUnit)) -∗
+  WP Fork e @ s; tid; E {{ Φ }}.
+Proof.
+  iIntros "Htid He HΦ". iApply wp_lift_atomic_head_step; [done|].
+  iIntros (extr auxtr K tp1 tp2 σ1 Hvalex Hexend Hloc) "(% & Hsi & Hmi)".
+  iMod (update_fork_step R1 R2 _
+       (tp1 ++ ectx_language.fill K (Val $ LitV LitUnit) :: tp2 ++ [e])
+       _ _ _ e _ σ1 with "Htid Hmi") as
+    (δ2 Hvse) "(Hfuels1 & Hfuels2 & Hmi)".
+  { done. }
+  { done. }
+  { rewrite /trace_ends_in in Hexend. rewrite Hexend. done. }
+  { rewrite -Hloc. rewrite -(language.locale_fill _ _ K).
+    rewrite /trace_ends_in in Hexend. rewrite Hexend.
+    econstructor 1 =>//.
+    apply fill_step, head_prim_step. econstructor. }
+  { list_simplifier. exists (tp1 ++ fill K #() :: tp2).
+    rewrite /trace_ends_in in Hexend. rewrite Hexend.
+    split; first by list_simplifier.
+    apply heap_lang_locales_equiv_length. simpl.
+    rewrite !length_app //=. }
+  iModIntro. iSplit. iPureIntro; first by eauto. iNext.
+  iIntros (e2 σ2 efs Hstep).
+  have [-> [-> ->]] : σ2 = σ1 ∧ efs = [e] ∧ e2 = Val $ LitV LitUnit by inv_head_step.
+  iMod ("HΦ" with "Hfuels1") as "HΦ". iModIntro. iExists δ2, (Silent_step tid).
+  iFrame. rewrite Hexend /=. iFrame "Hsi". iSplit; [by iPureIntro|].
+  iSplit; [|done]. iApply "He". by list_simplifier.
+Qed.
+
+End lifting.
diff --git a/fairis/map_included_utils.v b/fairis/map_included_utils.v
index e69eb39..d7fa80a 100644
--- a/fairis/map_included_utils.v
+++ b/fairis/map_included_utils.v
@@ -1,10 +1,10 @@
-From Coq Require Import ssreflect.
+From Stdlib Require Import ssreflect.
 From stdpp Require Import gmap.
 
 (* TODO: Make context, and generalise lemmas to canonical representation *)
 Lemma map_included_spec `{∀ A, Lookup K A (MAP A)} {A}
       (R : relation A) (m1 m2 : MAP A) :
-  map_included R m1 m2 ↔
+  map_included (fun _ => R) m1 m2 ↔
   (∀ k v1, m1 !! k = Some v1 → ∃ v2, m2 !! k = Some v2 ∧ R v1 v2).
 Proof.
   split.
@@ -26,8 +26,8 @@ Qed.
 Lemma map_included_insert `{Countable K} {A}
       (R : relation A) (m1 m2 : gmap K A) i x y :
   R x y →
-  map_included R m1 m2 →
-  map_included R (<[i:=x]>m1) (<[i:=y]>m2).
+  map_included (fun _ => R) m1 m2 →
+  map_included (fun _ => R) (<[i:=x]>m1) (<[i:=y]>m2).
 Proof.
   intros HR Hle.
   rewrite /map_included /map_relation /option_relation.
@@ -42,14 +42,14 @@ Qed.
 
 Lemma map_included_refl `{∀ A, Lookup K A (MAP A)} {A}
       `{!Reflexive R} (m : MAP A) :
-  map_included R m m.
+  map_included (fun _ => R) m m.
 Proof. rewrite map_included_spec. intros. by eauto. Qed.
 
 (* TODO: Move *)
 (* TODO: Generalise to map_included instead of subseteq? *)
 Lemma map_included_subseteq `{∀ A, Lookup K A (MAP A)} {A}
       (R : relation A) (m1 m2 m3 : MAP A) :
-  m1 ⊆ m2 → map_included R m2 m3 → map_included R m1 m3.
+  m1 ⊆ m2 → map_included (fun _ => R) m2 m3 → map_included (fun _ => R) m1 m3.
 Proof.
   rewrite /subseteq /map_subseteq !map_included_spec.
   intros Hle1 Hle2.
@@ -63,7 +63,7 @@ Qed.
 (* TODO: Generalise to better typeclasses *)
 Lemma map_included_subseteq_inv `{Countable K} {V}
       (R : relation V) (m1 m2 : gmap K V) :
-  map_included R m1 m2 → (dom m1) ⊆ (dom m2).
+  map_included (fun _ => R) m1 m2 → (dom m1) ⊆ (dom m2).
 Proof.
   rewrite /map_included /map_relation /option_relation.
   intros Hle k. rewrite !elem_of_dom. specialize (Hle k).
@@ -73,7 +73,7 @@ Qed.
 
 Lemma map_included_transitivity `{∀ A, Lookup K A (MAP A)} {A}
       `{!Transitive R} (m1 m2 m3 : MAP A) :
-  map_included R m1 m2 → map_included R m2 m3 → map_included R m1 m3.
+  map_included (fun _ => R) m1 m2 → map_included (fun _ => R) m2 m3 → map_included (fun _ => R) m1 m3.
 Proof.
   rewrite !map_included_spec.
   intros Hle1 Hle2.
@@ -87,7 +87,7 @@ Qed.
 (* TODO: Generalize types *)
 Lemma map_included_fmap `{Countable K} {A}
       (R : relation A) (m : gmap K A) (f : A → A) :
-  (∀ x:A, R x (f x)) → map_included R m (f <$> m).
+  (∀ x:A, R x (f x)) → map_included (fun _ => R) m (f <$> m).
 Proof.
   intros Hf. intros k. rewrite lookup_fmap.
   destruct (m !! k); [by apply Hf|done].
@@ -96,8 +96,8 @@ Qed.
 Lemma map_included_mono `{Countable K} {A}
       (R : relation A) (m1 m2 : gmap K A) (f : A → A) :
   (∀ x1 x2 : A, R x1 x2 → R (f x1) (f x2)) →
-  map_included R m1 m2 →
-  map_included R (f <$> m1) (f <$> m2).
+  map_included (fun _ => R) m1 m2 →
+  map_included (fun _ => R) (f <$> m1) (f <$> m2).
 Proof.
   rewrite !map_included_spec.
   intros Hf Hle. intros k v1.  
@@ -116,8 +116,8 @@ Lemma map_included_mono_strong `{Countable K} {A}
      m1 !! k = Some x1 → m2 !! k = Some x2 →
      (f1 m1) !! k = Some y1 → (f2 m2) !! k = Some y2 →
      R x1 x2 → R y1 y2) →
-  map_included R m1 m2 →
-  map_included R (f1 m1) (f2 m2).
+  map_included (fun _ => R) m1 m2 →
+  map_included (fun _ => R) (f1 m1) (f2 m2).
 Proof.
   rewrite !map_included_spec.
   intros Hle1 Hle2 Hf HR. intros k v1.  
@@ -139,8 +139,8 @@ Lemma map_included_filter `{Countable K} {A}
       `{∀ x, Decision (P x)} :
   (∀ k x1 x2,
      m1 !! k = Some x1 → m2 !! k = Some x2 → P (k,x1) → P (k,x2)) →
-  map_included R m1 m2 →
-  map_included R (filter P m1) (filter P m2).
+  map_included (fun _ => R) m1 m2 →
+  map_included (fun _ => R) (filter P m1) (filter P m2).
 Proof.
   rewrite !map_included_spec.
   intros HP Hle k v1 HSome1.
@@ -156,7 +156,7 @@ Qed.
 
 Lemma map_included_subseteq_r `{∀ A, Lookup K A (MAP A)} {A}
       (R : relation A) (m1 m2 m3 : MAP A) :
-  m2 ⊆ m3 → map_included R m1 m2 → map_included R m1 m3.
+  m2 ⊆ m3 → map_included (fun _ => R) m1 m2 → map_included (fun _ => R) m1 m3.
 Proof.
   rewrite /subseteq /map_subseteq !map_included_spec.
   intros Hle1 Hle2.
@@ -169,7 +169,7 @@ Qed.
 
 Definition map_agree_R `{∀ A, Lookup K A (MAP A)} {A B}
            (R : A → B → Prop) (m1 : MAP A) (m2 : MAP B) :=
-  map_relation R (λ _, False) (λ _, False) m1 m2.
+  map_relation (fun _ => R) (λ _ _ , False) (λ _ _, False) m1 m2.
 
 Lemma map_agree_R_spec `{∀ A, Lookup K A (MAP A)} {A}
       (R : relation A) (m1 m2 : MAP A) :
@@ -193,8 +193,8 @@ Qed.
 
 Lemma map_included_delete `{Countable K} {V}
       (R : relation V) (m1 m2 : gmap K V) k :
-  map_included R m1 m2 →
-  map_included R (delete k m1) (delete k m2).
+  map_included (fun _ => R) m1 m2 →
+  map_included (fun _ => R) (delete k m1) (delete k m2).
 Proof.
   rewrite !map_included_spec.
   intros Hle k' v HSome.
@@ -285,7 +285,7 @@ Qed.
 Lemma map_included_R_agree `{Countable K} {V}
       (R : relation V) (m1 m2 : gmap K V) k v1 v2 :
   m1 !! k = Some v1 → m2 !! k = Some v2 →
-  map_included R m1 m2 →
+  map_included (fun _ => R) m1 m2 →
   R v1 v2.
 Proof.
   rewrite map_included_spec.
@@ -296,7 +296,7 @@ Qed.
 
 Lemma map_included_map_agree_R `{Countable K} {V}
       (R : relation V) (m1 m2 : gmap K V) :
-  map_included R m1 m2 →
+  map_included (fun _ => R) m1 m2 →
   ∃ m21 m22,
     m2 = m21 ∪ m22 ∧
     m21 ##ₘ m22 ∧
@@ -347,7 +347,7 @@ Qed.
 
 Lemma map_agree_R_map_included `{Countable K} {V}
       (R : relation V) (m1 m2 : gmap K V) :
-  map_agree_R R m1 m2 → map_included R m1 m2.
+  map_agree_R R m1 m2 → map_included (fun _ => R) m1 m2.
 Proof.
   rewrite map_included_spec map_agree_R_spec.
   by intros [Hle _].
@@ -482,4 +482,3 @@ Proof.
     apply Hf in HR.
     by eauto.
 Qed.
-
diff --git a/fairis/heap_lang/proofmode.v b/fairis/proofmode.v
similarity index 99%
rename from fairis/heap_lang/proofmode.v
rename to fairis/proofmode.v
index 961402e..2e8a169 100644
--- a/fairis/heap_lang/proofmode.v
+++ b/fairis/proofmode.v
@@ -1,8 +1,8 @@
 From iris.proofmode Require Import coq_tactics reduction spec_patterns.
 From iris.proofmode Require Export tactics.
 From trillium.program_logic Require Import atomic.
-From trillium.fairness.heap_lang Require Export tactics lifting. (* derived_laws. *)
-From trillium.fairness.heap_lang Require Import notation.
+From fairis Require Import fuel heap_lang_lm resources lifting.
+(* From trillium.fairness.heap_lang Require Import notation. *)
 From iris.prelude Require Import options.
 Import uPred.
 
diff --git a/fairis/resources.v b/fairis/resources.v
index d67eb05..8f71a2b 100644
--- a/fairis/resources.v
+++ b/fairis/resources.v
@@ -1,21 +1,22 @@
 From iris.algebra Require Import auth gmap gset excl.
 From iris.proofmode Require Import tactics.
-From trillium.fairness Require Import fairness fuel map_included_utils.
+From fairness Require Import fairness.
+From fairis Require Import fuel map_included_utils.
 
 Canonical Structure ModelO (Mdl : FairModel) := leibnizO Mdl.
 Canonical Structure RoleO (Mdl : FairModel) := leibnizO (Mdl.(fmrole)).
 Canonical Structure localeO (Λ : language) := leibnizO (locale Λ).
 
 Class fairnessGpreS `{Countable (locale Λ)} `(LM: LiveModel Λ M) Σ := {
-  fairnessGpreS_model :> inG Σ (authUR (optionUR (exclR (ModelO M))));
-  fairnessGpreS_model_fuel_mapping :>
+  fairnessGpreS_model :: inG Σ (authUR (optionUR (exclR (ModelO M))));
+  fairnessGpreS_model_fuel_mapping ::
     inG Σ (authUR (gmapUR (localeO Λ)
                           (exclR $ gmapUR (RoleO M) natO)));
-  fairnessGpreS_model_free_roles :> inG Σ (authUR (gset_disjUR (RoleO M)));
+  fairnessGpreS_model_free_roles :: inG Σ (authUR (gset_disjUR (RoleO M)));
 }.
 
 Class fairnessGS `{Countable (locale Λ)} `(LM : LiveModel Λ M) Σ := FairnessGS {
-  fairness_inG :> fairnessGpreS LM Σ;
+  fairness_inG :: fairnessGpreS LM Σ;
   (** Underlying model *)
   fairness_model_name : gname;
   (** Mapping of threads to roles with fuel *)
@@ -197,8 +198,8 @@ Section model_state_interp.
     own (fairness_model_free_roles_name fG) (◯ (GSet FR)).
 
   Definition fuel_map_le_inner (m1 m2 : gmap (locale Λ) (gmap Role nat)) :=
-    map_included (λ (fs1 fs2 : gmap Role nat),
-                    map_included (≤) fs1 fs2) m1 m2.
+    map_included (λ _ (fs1 fs2 : gmap Role nat),
+                    map_included (fun _ => (≤)) fs1 fs2) m1 m2.
 
   Definition fuel_map_le (m1 m2 : gmap (locale Λ) (gmap Role nat)) :=
     fuel_map_le_inner m1 m2 ∧
@@ -516,7 +517,7 @@ Section model_state_lemmas.
         (fs fs' : gmap _ nat) ζ :
     δ.(ls_map) !! ζ = Some fs →
     fs ≠ ∅ →
-    map_included (<) fs' fs →
+    map_included (fun _ => (<)) fs' fs →
     (dom fs ∖ dom fs') ∩ M.(live_roles) δ = ∅ →
     ∃ δ', δ'.(ls_data) =
           {| ls_under := δ;
@@ -537,7 +538,7 @@ Section model_state_lemmas.
     δ.(ls_map) !! ζ = Some fs →
     δ'.(ls_map) = <[ζ := fs']>δ.(ls_map) →
     fs ≠ ∅ →
-    map_included (<) fs' fs →
+    map_included (fun _ => (<)) fs' fs →
     (dom fs ∖ dom fs') ∩ M.(live_roles) δ = ∅ →
     ls_trans fl δ (Silent_step ζ) δ'.
   Proof.
@@ -556,7 +557,7 @@ Section model_state_lemmas.
       δ1.(ls_map) !! ζ = Some fs1 ∧
       δ2.(ls_map) = <[ζ := fs2]>δ1.(ls_map) ∧
       fs1 ≠ ∅ ∧
-      map_included (<) fs2 fs1 ∧
+      map_included (fun _ => (<)) fs2 fs1 ∧
       (dom fs1 ∖ dom fs2) ∩ M.(live_roles) δ1 = ∅.
 
   Lemma model_can_fuel_step_trans fl ζ (δ δ' : LiveState Λ M) :
@@ -568,7 +569,7 @@ Section model_state_lemmas.
   Definition decr_fuel_map (fs : gmap (fmrole M) nat) : gmap (fmrole M) nat :=
     (λ f, f - 1) <$> fs.
 
-  Lemma decr_fuel_map_included fs : map_included (≤) (decr_fuel_map fs) fs.
+  Lemma decr_fuel_map_included fs : map_included (fun _ => (≤)) (decr_fuel_map fs) fs.
   Proof.
     apply map_included_spec. intros k v1 Hm.
     apply lookup_fmap_Some in Hm as [v2 [Hv2 Hm]].
@@ -581,7 +582,7 @@ Section model_state_lemmas.
     (filter (λ ρf, ρf.1 ∈ M.(live_roles) δ.(ls_under) ∨ ρf.1 ∈ ρs)) fs.
 
   Lemma filter_fuel_map_included δ ρs fs :
-    map_included (≤) (filter_fuel_map δ ρs fs) fs.
+    map_included (fun _ => (≤)) (filter_fuel_map δ ρs fs) fs.
   Proof.
     apply map_included_spec.
     intros k v1 Hm.
@@ -598,7 +599,7 @@ Section model_state_lemmas.
     decr_fuel_map ∘ filter_fuel_map δ ρs.
 
   Lemma model_update_locale_role_map_map_included δ ρs fs :
-    map_included (≤) (model_update_locale_role_map δ ρs fs) fs.
+    map_included (fun _ => (≤)) (model_update_locale_role_map δ ρs fs) fs.
   Proof.
     rewrite /model_update_locale_role_map.
     eapply map_included_transitivity;
@@ -621,7 +622,7 @@ Section model_state_lemmas.
     intros ζ δ ζ1 ζ2 fs1 fs2 Hneq HSome1 HSome2.
     simpl in *.
     pose proof δ.(ls_map_disj) as Hdisj.
-    assert (∃ fs1', map_included (≤) fs1 fs1' ∧ ls_map δ !!! ζ1 = fs1')
+    assert (∃ fs1', map_included (fun _ => (≤)) fs1 fs1' ∧ ls_map δ !!! ζ1 = fs1')
       as (fs1' & Hle1 & Hfs1').
     { destruct (decide (ζ = ζ1)) as [<-|Hneq'].
       + rewrite lookup_alter in HSome1.
@@ -633,7 +634,7 @@ Section model_state_lemmas.
       + rewrite lookup_alter_ne in HSome1; [|done].
         rewrite lookup_total_alt. eexists _.
         split; [done|by rewrite HSome1]. }
-    assert (∃ fs2', map_included (≤) fs2 fs2' ∧ ls_map δ !!! ζ2 = fs2')
+    assert (∃ fs2', map_included (fun _ => (≤)) fs2 fs2' ∧ ls_map δ !!! ζ2 = fs2')
       as (fs2' & Hle2 & Hfs2').
     { destruct (decide (ζ = ζ2)) as [<-|Hneq'].
       + rewrite lookup_alter in HSome2.
@@ -691,7 +692,7 @@ Section model_state_lemmas.
     intros ζ ρs δ ζ1 ζ2 fs1 fs2 Hneq HSome1 HSome2.
     simpl in *.
     pose proof δ.(ls_map_disj) as Hdisj.
-    assert (∃ fs1', map_included (≤) fs1 fs1' ∧ ls_map δ !!! ζ1 = fs1')
+    assert (∃ fs1', map_included (fun _ => (≤)) fs1 fs1' ∧ ls_map δ !!! ζ1 = fs1')
       as (fs1' & Hle1 & Hfs1').
     { destruct (decide (ζ = ζ1)) as [<-|Hneq'].
       + rewrite lookup_alter in HSome1.
@@ -703,7 +704,7 @@ Section model_state_lemmas.
       + rewrite lookup_alter_ne in HSome1; [|done].
         rewrite lookup_total_alt. eexists _.
         split; [done|by rewrite HSome1]. }
-    assert (∃ fs2', map_included (≤) fs2 fs2' ∧ ls_map δ !!! ζ2 = fs2')
+    assert (∃ fs2', map_included (fun _ => (≤)) fs2 fs2' ∧ ls_map δ !!! ζ2 = fs2')
       as (fs2' & Hle2 & Hfs2').
     { destruct (decide (ζ = ζ2)) as [<-|Hneq'].
       + rewrite lookup_alter in HSome2.
@@ -1198,7 +1199,7 @@ Section model_state_lemmas.
     δ2.(ls_map) = <[ζ := fs']> δ1.(ls_map) →
     ρ ∈ dom fs →
     fs' !! ρ = Some (LM.(lm_fl) (ls_under δ2)) →
-    map_included (<) (delete ρ fs') fs →
+    map_included (fun _ => (<)) (delete ρ fs') fs →
     (dom fs ∖ dom fs' ∩ M.(live_roles) δ1 = ∅) →
     ls_trans LM.(lm_fl) δ1 (Take_step ρ ζ) δ2.
   Proof.
@@ -1227,7 +1228,7 @@ Section model_state_lemmas.
       δ2.(ls_map) = <[ζ := fs']> δ1.(ls_map) ∧
       ρ ∈ dom fs ∧
       fs' !! ρ = Some (LM.(lm_fl) (ls_under δ2)) ∧
-      map_included (<) (delete ρ fs') fs ∧
+      map_included (fun _ => (<)) (delete ρ fs') fs ∧
       (dom fs ∖ dom fs' ∩ M.(live_roles) δ1 = ∅).
 
   Lemma model_can_model_step_trans ζ ρ (δ δ' : LiveState Λ M) :
@@ -1753,8 +1754,8 @@ Section model_state_lemmas.
       δ1.(ls_under) = δ2.(ls_under) ∧
       δ1.(ls_map) !! ζ = Some fs ∧ fs ≠ ∅ ∧
       δ2.(ls_map) = <[ζ := fs1]>(<[ζf := fs2]> δ1.(ls_map)) ∧
-      map_included (<) fs1 fs ∧
-      map_included (<) fs2 fs ∧
+      map_included (fun _ => (<)) fs1 fs ∧
+      map_included (fun _ => (<)) fs2 fs ∧
       (dom fs ∖ (dom fs1 ∪ dom fs2) ∩ M.(live_roles) δ1 = ∅) ∧
       (dom fs1 ∩ dom fs2 = ∅) ∧
       ζf ∉ dom δ1.(ls_map).
@@ -1763,8 +1764,8 @@ Section model_state_lemmas.
         (fs fs1 fs2 : gmap _ nat) ζ ζf :
     δ.(ls_map) !! ζ = Some fs →
     fs ≠ ∅ →
-    map_included (<) fs1 fs →
-    map_included (<) fs2 fs →
+    map_included (fun _ => (<)) fs1 fs →
+    map_included (fun _ => (<)) fs2 fs →
     (dom fs ∖ (dom fs1 ∪ dom fs2)) ∩ M.(live_roles) δ = ∅ →
     (dom fs1 ∩ dom fs2 = ∅) →
     ζf ∉ dom δ.(ls_map) →
@@ -1787,8 +1788,8 @@ Section model_state_lemmas.
     δ.(ls_map) !! ζ = Some fs →
     δ'.(ls_map) = <[ζ := fs1]>(<[ζf := fs2]> δ.(ls_map)) →
     fs ≠ ∅ →
-    map_included (<) fs1 fs →
-    map_included (<) fs2 fs →
+    map_included (fun _ => (<)) fs1 fs →
+    map_included (fun _ => (<)) fs2 fs →
     (dom fs ∖ (dom fs1 ∪ dom fs2)) ∩ M.(live_roles) δ = ∅ →
     (dom fs1 ∩ dom fs2 = ∅) →
     ζf ∉ dom δ.(ls_map) →
@@ -2010,7 +2011,7 @@ Section model_state_lemmas.
 
   Lemma model_state_interp_has_fuels_agree es δ ζ (fs : gmap (fmrole M) nat) :
     model_state_interp es δ -∗ has_fuels ζ fs -∗
-    ⌜∃ fs', δ.(ls_map) !! ζ = Some fs' ∧ map_included (≤) fs fs'⌝.
+    ⌜∃ fs', δ.(ls_map) !! ζ = Some fs' ∧ map_included (fun _ => (≤)) fs fs'⌝.
   Proof.
     iIntros "Hm Hf".
     iDestruct "Hm" as (fm [Hfmle _] Hfmdead Htp) "(Hm & Hfm)".
diff --git a/fairness/fairness.v b/fairness/fairness.v
new file mode 100644
index 0000000..629fe23
--- /dev/null
+++ b/fairness/fairness.v
@@ -0,0 +1,356 @@
+From stdpp Require Import option countable gmap ssreflect.
+From Paco Require Import paco1 paco2 pacotac.
+From fairness Require Export inftraces trace_lookup utils.
+From trillium.program_logic Require Export traces.
+From trillium.program_logic Require Import language adequacy.
+From Stdlib Require Import Logic.Classical.
+  
+
+Record FairModel : Type := {
+  fmstate:> Type;
+  fmstate_eqdec: EqDecision fmstate;
+  fmstate_inhabited: Inhabited fmstate;
+
+  fmrole: Type;
+  fmrole_eqdec: EqDecision fmrole;
+  fmrole_countable: Countable fmrole;
+  fmrole_inhabited: Inhabited fmrole;
+
+  fmtrans: fmstate -> option fmrole -> fmstate -> Prop;
+
+  live_roles: fmstate -> gset fmrole;
+  fm_live_spec: forall s ρ s', fmtrans s (Some ρ) s' -> ρ ∈ live_roles s;
+}.
+
+Definition fair_model_model `(FM : FairModel) : Model := {|
+    mstate := fmstate FM;
+    mlabel := option (fmrole FM);
+    mtrans := fmtrans FM;
+|}.
+
+
+#[global] Existing Instance fmrole_eqdec.
+#[global] Existing Instance fmrole_countable.
+#[global] Existing Instance fmrole_inhabited.
+#[global] Existing Instance fmstate_inhabited.
+
+
+(** Definition of fairness for all kinds of traces *)
+Section GeneralizedFairness.
+  Context {S L T: Type}.
+  Context (locale_prop: T -> S -> Prop).
+  Context (does_step: T -> S -> option (L * S) -> Prop).
+
+  Definition fairness_sat_gen (t: T) (s: S) (step: option (L * S)) :=
+    ¬ locale_prop t s \/ does_step t s step. 
+
+  Definition fair_by_gen (t: T) (otr: trace S L): Prop :=
+    forall n, pred_at otr n (λ c _, locale_prop t c) ->
+         exists m s step, otr !! (n + m) = Some (s, step) /\ fairness_sat_gen t s step. 
+
+  Lemma fair_by_gen_after t tr tr' k:
+    after k tr = Some tr' ->
+    fair_by_gen t tr -> fair_by_gen t tr'.
+  Proof.
+    intros Haf Hf n Hp.
+    have Hh:= Hf (k+n).
+    have Hp': pred_at tr (k + n) (λ (c : S) (_ : option L), locale_prop t c).
+    { rewrite (pred_at_sum _ k) Haf /= //. }
+    have [m Hm] := Hh Hp'.
+    destruct Hm as (s & step & STEP & SAT). 
+    do 3 eexists. split; eauto.
+    erewrite trace_lookup_after; eauto.
+    rewrite Nat.add_assoc. eauto. 
+  Qed.
+
+  Lemma fair_by_gen_cons (t: T) (c: S) (tid' : L) (r : trace S L):
+      fair_by_gen t (c -[ tid' ]-> r) → fair_by_gen t r.
+  Proof. intros H. by eapply (fair_by_gen_after t (c -[tid']-> r) r 1). Qed.
+
+  Lemma fair_by_gen_cons_forall δ ℓ' r:
+    (∀ ℓ, fair_by_gen ℓ (δ -[ℓ']-> r)) -> (∀ ℓ, fair_by_gen ℓ r).
+  Proof. eauto using fair_by_gen_cons. Qed.
+
+  Definition fair_by_gen'
+    (t: T) (otr: trace S L) :=
+    forall n, from_option (locale_prop t) False (otr S!! n) ->
+    exists m s' step, otr !! (n + m) = Some (s', step) /\
+                  fairness_sat_gen t s' step.
+
+  Definition fair_by_gen'_strong
+    (t: T) (otr: trace S L) :=
+    forall n, from_option (locale_prop t) False (otr S!! n) ->
+    exists m s' step, otr !! (n + m) = Some (s', step) /\
+                  fairness_sat_gen t s' step /\
+                  (forall k sk stepk, n <= k < n + m -> otr !! k = Some (sk, stepk) ->
+                                 ¬ fairness_sat_gen t sk stepk).   
+
+  Lemma fair_by_gen_equiv:
+    forall (t: T) (otr: trace S L),
+      fair_by_gen t otr <-> fair_by_gen' t otr.
+  Proof.
+    intros. rewrite /fair_by_gen /fair_by_gen'.    
+    apply forall_proper. intros n.
+    repeat setoid_rewrite pred_at_trace_lookup.
+    apply Morphisms_Prop.iff_iff_iff_impl_morphism.
+    2: { done. }
+    destruct (otr S!! n); simpl; set_solver.
+  Qed.
+
+  Lemma fair_by_gen'_strong_equiv
+    `{forall t s, Decision (locale_prop t s)} `{forall t s step, Decision (does_step t s step)}:
+    forall (t: T) (otr: trace S L), fair_by_gen' t otr <-> fair_by_gen'_strong t otr.
+  Proof. 
+    intros. rewrite /fair_by_gen'_strong /fair_by_gen'. split.
+    2: { intros FAIR ? EN. specialize (FAIR _ EN) as (?&?&?&?&?&?). eauto. }
+    intros FAIR ? EN. specialize (FAIR _ EN) as [m_ STEP].
+    pattern m_ in STEP. eapply min_prop_dec in STEP.
+    2: { intros k. destruct (otr !! (n + k)) as [[s step]| ] eqn:K.
+         2: { right. set_solver. }
+         eapply Decision_iff_impl.
+         { rewrite ex_det_iff; [rewrite ex_det_iff| ]; [reflexivity| ..].
+           - intros ? [[=] ?]. subst. reflexivity.
+           - intros ? (?& [=] & ?). subst. reflexivity. }
+         apply and_dec; try solve_decision.
+         by left. }
+    clear dependent m_. destruct STEP as (m & (?&?&?&?) & MINm).
+    do 3 eexists. repeat split; eauto.
+    intros k * [LE LT] KTH. intros SAT.
+    apply Nat.le_sum in LE as [d ->]. 
+    specialize (MINm d ltac:(eauto)). lia.
+  Qed.
+
+End GeneralizedFairness.
+
+Global Instance fair_by_gen_Proper {S L T: Type}:
+  Proper ((eq ==> eq ==> iff) ==> (eq ==> eq ==> eq ==> iff) ==> eq ==> eq ==> iff) 
+    (@fair_by_gen S L T).
+Proof.
+  intros ?? LOC_IFF ?? STEP_IFF.
+  red. intros ?? ->. red. intros ?? ->.
+  rewrite /fair_by_gen.
+  apply forall_proper. intros.
+  erewrite pred_at_iff.
+  2: { intros. eapply LOC_IFF; reflexivity. }
+  apply Morphisms_Prop.iff_iff_iff_impl_morphism; [reflexivity| ].
+  repeat (apply exist_proper; intros).
+  apply Morphisms_Prop.and_iff_morphism; [done| ].
+  rewrite /fairness_sat_gen. 
+  apply Morphisms_Prop.or_iff_morphism.
+  - apply not_iff_compat, LOC_IFF; reflexivity.
+  - apply STEP_IFF; reflexivity. 
+Qed. 
+
+
+Section LocaleFairness.
+  (** TODO: this is in fact a case of fair_by_gen with a simpler does_step relation,
+      but formalizing it would require some routine work to adjust all the proofs. *)
+  Context {S L T: Type}.
+  Context (locale_prop: T -> S -> Prop).
+  Context (does_step: T -> L -> Prop).
+
+  Definition fairness_sat (t: T) (s: S) (ol: option L) :=
+    ¬ locale_prop t s \/ exists ℓ, ol = Some ℓ /\ does_step t ℓ. 
+
+  Definition fair_by (t: T) (otr: trace S L): Prop :=
+    forall n, pred_at otr n (λ c _, locale_prop t c) ->
+         exists m, pred_at otr (n + m) (fairness_sat t). 
+
+  Lemma fair_by_after t tr tr' k:
+    after k tr = Some tr' ->
+    fair_by t tr -> fair_by t tr'.
+  Proof.
+    intros Haf Hf n Hp.
+    have Hh:= Hf (k+n).
+    have Hp': pred_at tr (k + n) (λ (c : S) (_ : option L), locale_prop t c).
+    { rewrite (pred_at_sum _ k) Haf /= //. }
+    have [m Hm] := Hh Hp'. exists m.
+    red. by rewrite <- Nat.add_assoc, !(pred_at_sum _ k), Haf in Hm.
+  Qed.
+
+  Lemma fair_by_cons (t: T) (c: S) (tid' : L) (r : trace S L):
+      fair_by t (c -[ tid' ]-> r) → fair_by t r.
+  Proof. intros H. by eapply (fair_by_after t (c -[tid']-> r) r 1). Qed.
+
+  Lemma fair_by_cons_forall δ ℓ' r:
+    (∀ ℓ, fair_by ℓ (δ -[ℓ']-> r)) -> (∀ ℓ, fair_by ℓ r).
+  Proof. eauto using fair_by_cons. Qed.
+
+  Definition fair_by' (t: T) (otr: trace S L) :=
+    forall n, from_option (locale_prop t) False (otr S!! n) ->
+    exists m s', otr S!! (n + m) = Some s' /\
+             fairness_sat t s' (otr L!! (n + m)).
+
+  Definition fair_by'_strong (t: T) (otr: trace S L) :=
+    forall n, from_option (locale_prop t) False (otr S!! n) ->
+    exists m, ClassicalFacts.Minimal 
+           (fun d => exists s', otr S!! (n + d) = Some s' /\ fairness_sat t s' (otr L!! (n + d))) m.
+
+  Lemma fair_by_equiv:
+    forall (t: T) (otr: trace S L), fair_by t otr <-> fair_by' t otr.
+  Proof.
+    intros. rewrite /fair_by /fair_by'.
+    apply forall_proper. intros n.
+    repeat setoid_rewrite pred_at_trace_lookup.
+    apply Morphisms_Prop.iff_iff_iff_impl_morphism; [| done].    
+    destruct (otr S!! n); simpl; set_solver.
+  Qed.
+
+  Global Instance fairness_sat_dec
+    `{forall t s, Decision (locale_prop t s)}
+    `{forall t l, Decision (does_step t l)}:
+    forall t s ol, Decision (fairness_sat t s ol).
+  Proof using.
+    intros. rewrite /fairness_sat.
+    destruct (decide (locale_prop t s)) as [EN| ]; [| left; tauto]. 
+    destruct ol as [l| ]; [| right; set_solver].
+    destruct (decide (does_step t l)).
+    - left. eauto.
+    - right. set_solver.
+  Qed.
+
+  Lemma fair_by'_strenghten
+    `{forall t s ol, Decision (fairness_sat t s ol)}:
+    forall (t: T) (otr: trace S L), fair_by' t otr <-> fair_by'_strong t otr.
+  Proof using.
+    intros. rewrite /fair_by' /fair_by'_strong.
+    apply forall_proper. intros n.
+    apply impl_iff_intro. intros Pn. destruct (otr S!! n) eqn:NTH; [| done].
+    simpl in Pn.
+    split.
+    2: { intros (?&?&?). eauto. }
+    intros [m EX]. pattern m in EX. apply min_prop_dec_impl in EX.
+    { destruct EX. eauto. }
+    intros i. destruct (otr S!! (n + i)) eqn:NEXT.
+    2: { right. set_solver. }
+    destruct (decide (fairness_sat t s0 (otr L!! (n + i)))).
+    - left. eauto.
+    - right. set_solver.
+  Qed.
+
+  Definition weakly_fair (t: T) (tr: trace S L) :=
+    forall n,
+      is_Some (tr S!! n) ->
+      (** using True as default to support finite traces *)
+      (forall k, n <= k -> from_option (locale_prop t) True (tr S!! k)) ->
+    exists m ℓ, tr L!! (n + m) = Some ℓ /\ does_step t ℓ. 
+
+  Lemma fair_by'_weakly_fair τ tr:
+    fair_by' τ tr <-> weakly_fair τ tr.
+  Proof using.
+    rewrite /fair_by' /weakly_fair. apply forall_proper. intros n.
+    split.
+    - intros FAIR [δ NTH] ALW.
+      pose proof (ALW n ltac:(lia)) as ENn. rewrite NTH /= in ENn.
+      rewrite NTH in FAIR. ospecialize (FAIR ltac:(done)).
+      destruct FAIR as (d & δ' & MTH & SAT).
+      destruct SAT as [DIS | STEP]; [| by eauto].
+      specialize (ALW (n + d) ltac:(lia)). by rewrite MTH in ALW.
+    - intros FAIR.
+      destruct (tr S!! n) as [δ | ] eqn:NTH; [| done]. simpl in *.
+      intros ENn. specialize (FAIR ltac:(done)).
+      destruct (classic (∀ k, n ≤ k → from_option (locale_prop τ) True (tr S!! k))).
+      { specialize (FAIR H). destruct FAIR as (m & ℓ & MTHl & STEP).
+        pose proof MTHl as [[? MTH] _]%mk_is_Some%label_lookup_states.
+        do 2 eexists. split; eauto. right. eauto. }
+      apply not_forall_exists_not in H as [m DIS].
+      apply imply_to_and in DIS as [LE DIS].
+      destruct (tr S!! m) as [? | ] eqn:MTH; [| done]. simpl in *.
+      apply Nat.le_sum in LE as [? ->].
+      do 2 eexists. split; eauto.
+      by left.
+  Qed.
+
+End LocaleFairness.
+
+Definition extrace Λ := trace (cfg Λ) (olocale Λ).
+
+Section exec_trace.
+  Context {Λ : language}.
+  Context `{EqDecision (locale Λ)}.
+
+  Definition locale_enabled (ζ : locale Λ) (c: cfg Λ) :=
+    ∃ e, from_locale c.1 ζ = Some e ∧ to_val e = None.
+
+  Definition tid_match (ζ : locale Λ) (oζ': olocale Λ) :=
+    oζ' = Some ζ. 
+
+  Definition fair_ex ζ (extr: extrace Λ): Prop :=
+    fair_by locale_enabled tid_match ζ extr. 
+
+  CoInductive extrace_valid: extrace Λ -> Prop :=
+  | extrace_valid_singleton c: extrace_valid ⟨c⟩
+  | extrace_valid_cons c oζ tr:
+      locale_step c oζ (trfirst tr) ->
+      extrace_valid tr →
+      extrace_valid (c -[oζ]-> tr).
+
+  Lemma to_trace_preserves_validity ex iex:
+    extrace_valid (to_trace (trace_last ex) iex) -> valid_exec ex -> valid_inf_exec ex iex.
+  Proof.
+    revert ex iex. cofix CH. intros ex iex Hexval Hval.
+    rewrite (trace_unfold_fold (to_trace _ _)) in Hexval.
+    destruct iex as [|[??] iex]; first by econstructor. cbn in Hexval.
+    inversion Hexval. simplify_eq.
+    econstructor; try done.
+    - by destruct iex as [|[??]?].
+    - apply CH; eauto. econstructor; try done. by destruct iex as [|[??]?].
+  Qed.
+
+  Lemma from_trace_preserves_validity (extr: extrace Λ) ex:
+    extrace_valid extr ->
+    valid_exec ex ->
+    trace_last ex = trfirst extr ->
+    valid_inf_exec ex (from_trace extr).
+  Proof.
+    revert ex extr. cofix CH. intros ex extr Hexval Hval Heq.
+    rewrite (inflist_unfold_fold (from_trace extr)). destruct extr as [c|c tid tr]; cbn;
+     first by econstructor.
+    inversion Hexval; simplify_eq; econstructor; eauto. apply CH; eauto.
+      by econstructor.
+  Qed.
+
+  Lemma from_trace_preserves_validity_singleton (extr: extrace Λ):
+    extrace_valid extr ->
+    valid_inf_exec (trace_singleton (trfirst extr)) (from_trace extr).
+  Proof.
+    intros ?. eapply from_trace_preserves_validity; eauto. econstructor.
+  Qed.
+
+  Definition extrace_fairly_terminating (extr : extrace Λ) :=
+    extrace_valid extr →
+    (∀ tid, fair_ex tid extr) →
+    terminating_trace extr.
+
+End exec_trace.
+
+
+Definition mtrace (M:FairModel) := trace M (option M.(fmrole)).
+
+Section model_traces.
+  Context `{M: FairModel}.
+
+  Definition role_enabled_model ρ (s: M) := ρ ∈ M.(live_roles) s.
+
+  Global Instance rem_dec: forall ρ st, Decision (role_enabled_model ρ st).
+  Proof. 
+    intros. rewrite /role_enabled_model. solve_decision.
+  Qed.
+
+  Definition role_match (ρ : fmrole M) (oρ': option $ fmrole M) :=
+    oρ' = Some ρ. 
+
+  Definition fair_model_trace ρ (mtr: mtrace M): Prop  :=
+    fair_by role_enabled_model role_match ρ mtr. 
+
+  Definition mtrace_valid := trace_valid (fmtrans M). 
+
+End model_traces.
+
+
+Definition FM_strong_lr (FM: FairModel) :=
+  forall st ρ, ρ ∈ live_roles FM st <-> exists st', fmtrans FM st (Some ρ) st'.
+
+
+Global Hint Resolve fair_by_cons: core.
+Global Hint Resolve trace_valid_mono : paco.
diff --git a/fairness/fin_branch.v b/fairness/fin_branch.v
new file mode 100644
index 0000000..c6822f5
--- /dev/null
+++ b/fairness/fin_branch.v
@@ -0,0 +1,56 @@
+From stdpp Require Import base sets.
+From iris.proofmode Require Import tactics.
+From fairness Require Import utils.
+From trillium.prelude Require Import classical_instances.
+
+
+Section ListApprox.
+  Context {A: Type}.
+
+  Definition list_approx (P: A -> Prop) :=
+    { l: list A | forall a, P a -> a ∈ l }. 
+
+  Fixpoint list_approx_repeat (R: A -> A → Prop)
+      (APX: forall a, list_approx (R a))      
+      (n: nat)
+      (a: A)
+      :=
+      match n with
+      | 0 => [a]
+      | S n =>
+          let la := APX a in
+          flat_map (list_approx_repeat R APX n) (proj1_sig la)
+      end.
+
+  Lemma list_approx_repeat_spec (R: A -> A -> Prop) APX n a:
+    forall b, relations.nsteps R n a b -> b ∈ list_approx_repeat R APX n a.
+  Proof using.
+    revert a. induction n.
+    { simpl. intros ??. rewrite nsteps_0. set_solver. }
+    intros ??. rewrite -rel_compose_nsteps_next'.       
+    intros (? & STEP & STEPS). 
+    apply IHn in STEPS. simpl.
+    apply elem_of_list_In. apply in_flat_map. eexists. split.
+    2: eapply elem_of_list_In; eauto.
+    destruct APX. simpl in *. apply elem_of_list_In. eauto.
+  Qed.
+
+End ListApprox.
+
+Section SmallerCardLA.
+  Context {A: Type}.
+  Context {EQDEC: EqDecision A}.
+  Context (P: A -> Prop).
+  
+  Local Instance P_PI: forall a, ProofIrrel (P a).
+  Proof using. intros. apply make_proof_irrel. Qed.  
+
+  Lemma list_approx_smaller_card (APX: list_approx P):
+    quantifiers.smaller_card {a | P a} nat.
+  Proof using EQDEC.
+    apply finitary.finite_smaller_card_nat.
+    destruct APX as [??]. 
+    by eapply finitary.in_list_finite.
+  Qed.
+
+End SmallerCardLA.
diff --git a/fairis/inftraces.v b/fairness/inftraces.v
similarity index 54%
rename from fairis/inftraces.v
rename to fairness/inftraces.v
index fe8e24e..8246c9c 100644
--- a/fairis/inftraces.v
+++ b/fairness/inftraces.v
@@ -1,11 +1,10 @@
-From trillium.program_logic Require Export adequacy.
 From stdpp Require Import option.
 From Paco Require Import paco1 paco2 pacotac.
+From trillium.program_logic Require Import adequacy.
+From fairness Require Import utils_logic.
 
-Require Import
-        Coq.Relations.Relation_Definitions
-        Coq.Relations.Relation_Operators.
-Require Import Coq.Arith.Wf_nat.
+From Stdlib Require Import Relations.Relation_Definitions Relations.Relation_Operators.
+From Stdlib Require Import Arith.Wf_nat.
 
 Section traces.
 
@@ -17,7 +16,7 @@ Section traces.
   Bind Scope trace_scope with trace.
 
   Arguments tr_singl {_} {_}, _.
-  Arguments tr_cons {_} {_} _ _ _%trace.
+  Arguments tr_cons {_} {_} _ _ _ %_trace.
   Notation "⟨ s ⟩" := (tr_singl s) : trace_scope.
   Notation "s -[ ℓ ]->  r" := (tr_cons s ℓ r) (at level 33) : trace_scope.
   Open Scope trace.
@@ -54,6 +53,10 @@ Section traces.
         end
       end.
 
+    Lemma after_0_id (tr : trace St L):
+      after 0 tr = Some tr.
+    Proof. done. Qed.
+
     Definition pred_at (tr: trace St L) (n: nat) (P: St -> option L -> Prop): Prop :=
       match after n tr with
       | None => False
@@ -83,6 +86,13 @@ Section traces.
         end.
     Proof. intros. rewrite Nat.add_comm. apply after_sum. Qed.
 
+    Lemma after_S_tr_cons (tr: trace St L) n s ℓ atr
+      (AFTER: after n tr = Some (s -[ℓ]-> atr)):
+      after (S n) tr = Some atr.
+    Proof. 
+      by rewrite -Nat.add_1_r after_sum' AFTER.
+    Qed.
+
     Lemma pred_at_sum P n m tr:
       pred_at tr (n + m) P <->
       match after n tr with
@@ -113,6 +123,54 @@ Section traces.
       pred_at (s -[ℓ]-> r) (S n) P <-> pred_at r n P.
     Proof. by unfold pred_at. Qed.
 
+    Lemma pred_at_state_trfirst (tr: trace St L) (P : St → Prop):
+      pred_at tr 0 (fun st _ => P st) ↔ P (trfirst tr).
+    Proof. 
+      rewrite /pred_at. destruct tr; eauto.
+    Qed.
+
+    Lemma pred_at_dec (P: St → option L → Prop)
+      (DEC: forall st ro, Decision (P st ro)):
+      forall tr i, Decision (pred_at tr i P).
+    Proof using.
+      intros tr i. unfold pred_at.
+      destruct (after i tr); [destruct t| ]; auto.
+      solve_decision.
+    Qed.
+    
+    Lemma pred_at_or
+      P1 P2 (tr: trace St L) i: 
+      pred_at tr i P1 \/ pred_at tr i P2 <-> pred_at tr i (fun x y => P1 x y \/ P2 x y).
+    Proof using.
+      unfold pred_at. destruct (after i tr); [destruct t| ]; tauto.
+    Qed.
+    
+    Lemma pred_at_ex {T: Type} (P : T -> St → option L → Prop) tr n:
+      pred_at tr n (fun s ol => exists t, P t s ol) <-> exists t, pred_at tr n (P t).
+    Proof.
+      rewrite /pred_at. destruct after.
+      2: { intuition. by destruct H. }
+      destruct t; eauto.
+    Qed.
+    
+    Lemma pred_at_impl (P Q: St -> option L -> Prop)
+      (IMPL: forall s ol, P s ol -> Q s ol):
+      forall tr i, pred_at tr i P -> pred_at tr i Q.
+    Proof.
+      rewrite /pred_at. intros. 
+      destruct after; intuition; destruct t.
+      all: by apply IMPL.
+    Qed.
+
+    Lemma pred_at_iff (P Q: St -> option L -> Prop)
+      (IFF: forall s ol, P s ol <-> Q s ol):
+      forall tr i, pred_at tr i P <-> pred_at tr i Q.
+    Proof.
+      intros. rewrite /pred_at.
+      destruct after; intuition; destruct t.
+      all: by apply IFF.
+    Qed.
+
     Definition infinite_trace tr :=
       forall n, is_Some (after n tr).
 
@@ -140,17 +198,86 @@ Section traces.
       intros Hinf n. specialize (Hinf (1+n)).
       rewrite (after_sum' _ 1) // in Hinf.
     Qed.
+
+    Lemma infinite_neg_finite (tr : trace St L):
+      terminating_trace tr <-> ¬ infinite_trace tr.
+    Proof.
+      rewrite /terminating_trace /infinite_trace. split.
+      - intros [n A]. intros A'. specialize (A' n). rewrite A in A'. by destruct A'.
+      - intros [n A%eq_None_not_Some]%not_forall_exists_not. eexists; eauto.
+    Qed. 
+
+    Lemma terminating_trace_after (tr atr: trace St L) i
+      (AFTER: after i tr = Some atr)
+      (FIN_ATR: terminating_trace atr):
+      terminating_trace tr.
+    Proof.
+      destruct FIN_ATR as [n FIN].
+      exists (i + n). by rewrite after_sum' AFTER.
+    Qed. 
+
   End after.
 
 End traces.
 
 Delimit Scope trace_scope with trace.
 Arguments tr_singl {_} {_}, _.
-Arguments tr_cons {_} {_} _ _ _%trace.
+Arguments tr_cons {_} {_} _ _ _ %_trace.
 Notation "⟨ s ⟩" := (tr_singl s) : trace_scope.
 Notation "s -[ ℓ ]->  r" := (tr_cons s ℓ r) (at level 33) : trace_scope.
 Open Scope trace.
 
+Section TraceValid.
+  Context {St L: Type}.
+  Context (trans: St -> L -> St -> Prop). 
+
+  Let traceM := trace St L. 
+
+  Inductive trace_valid_ind (trace_valid_coind: traceM -> Prop) :
+    traceM -> Prop :=
+  | trace_valid_singleton δ: trace_valid_ind _ ⟨δ⟩
+  | trace_valid_cons δ ℓ tr:
+      trans δ ℓ (trfirst tr) ->
+      trace_valid_coind tr →
+      trace_valid_ind _ (δ -[ℓ]-> tr).
+
+  Definition trace_valid := paco1 trace_valid_ind bot1.
+
+  Lemma trace_valid_mono :
+    monotone1 trace_valid_ind.
+  Proof.
+    unfold monotone1. intros x0 r r' IN LE.
+    induction IN; try (econstructor; eauto; done).
+  Qed.
+  Hint Resolve trace_valid_mono : paco.
+
+  Lemma trace_valid_after (mtr mtr' : traceM) k :
+    after k mtr = Some mtr' → trace_valid mtr → trace_valid mtr'.
+  Proof.
+    revert mtr mtr'.
+    induction k; intros mtr mtr' Hafter Hvalid.
+    { destruct mtr'; simpl in *; by simplify_eq. }
+    punfold Hvalid.
+    inversion Hvalid as [|??? Htrans Hval']; simplify_eq.
+    eapply IHk; [done|].
+    by inversion Hval'.
+  Qed.
+
+  Lemma trace_valid_tail s l (tr: traceM)
+    (VALID': trace_valid (s -[l]-> tr)):
+    trace_valid tr.
+  Proof. by eapply trace_valid_after with (k := 1); eauto. Qed.
+
+  Lemma trace_valid_cons_inv (tr: trace St L) s l
+    (VALID: trace_valid (s -[l]-> tr)):
+    trace_valid tr /\ trans s l (trfirst tr). 
+  Proof using.
+    punfold VALID. inversion VALID. subst.
+    pclearbot. done. 
+  Qed.
+
+End TraceValid.
+
 Section simulation.
   Context {L1 L2 S1 S2: Type}.
   Context (Rℓ: L1 -> L2 -> Prop) (Rs: S1 -> S2 -> Prop).
@@ -183,8 +310,111 @@ Section simulation.
     Rs (trfirst tr1) (trfirst tr2).
   Proof. intros Hm. inversion Hm; done. Qed.
 
+  Lemma traces_match_preserves_termination tr1 tr2 :
+    traces_match tr1 tr2 ->
+    terminating_trace tr2 ->
+    terminating_trace tr1.
+  Proof.
+    intros Hmatch [n HNone].
+    revert tr1 tr2 Hmatch HNone. induction n as [|n IHn]; first done.
+    intros tr1 tr2 Hmatch HNone.
+    replace (S n) with (1 + n) in HNone =>//.
+    rewrite (after_sum' _ 1) in HNone.
+    destruct tr2 as [s| s ℓ tr2'];
+      first by inversion Hmatch; simplify_eq; exists 1.
+    simpl in HNone.
+    inversion Hmatch; simplify_eq.
+    apply terminating_trace_cons.
+    eapply IHn =>//.
+  Qed.
+
+  Lemma traces_match_valid1
+    (tr1: trace S1 L1) (tr2: trace S2 L2):
+    traces_match tr1 tr2 ->
+    trace_valid trans1 tr1. 
+  Proof.
+    revert tr1 tr2. pcofix CH. intros tr1 tr2 Hmatch.
+    pfold. 
+    inversion Hmatch; [by econstructor| ].
+    constructor =>//.
+    specialize (CH _ _ H3).
+    eauto.   
+  Qed.
+  
+  Lemma traces_match_valid2
+    (tr1: trace S1 L1) (tr2: trace S2 L2):
+    traces_match tr1 tr2 ->
+    trace_valid trans2 tr2. 
+  Proof.
+    revert tr1 tr2. pcofix CH. intros tr1 tr2 Hmatch.
+    pfold. 
+    inversion Hmatch; [by econstructor| ].
+    constructor =>//.
+    specialize (CH _ _ H3).
+    eauto.   
+  Qed.  
+  
+  Lemma traces_match_after'
+    (tr1 : trace S1 L1) (tr2 : trace S2 L2) (n : nat) 
+    (tr1' : trace S1 L1):
+    traces_match tr1 tr2
+    → after n tr1 = Some tr1'
+    → ∃ tr2' : trace S2 L2,
+        after n tr2 = Some tr2' ∧ traces_match tr1' tr2'.
+  Proof.
+    revert tr1 tr2.
+    induction n; intros tr1 tr2.
+    { simpl. intros. exists tr2. simplify_eq. done. }
+    move=> /= Hm Ha. destruct tr1 as [|s ℓ tr1''] eqn:Heq; first done.
+    destruct tr2; first by inversion Hm.
+    inversion Hm; simplify_eq. by eapply IHn.
+  Qed.
+
 End simulation.
 
+Lemma traces_match_flip {S1 S2 L1 L2}
+  (Rℓ: L1 -> L2 -> Prop) (Rs: S1 -> S2 -> Prop)
+  (trans1: S1 -> L1 -> S1 -> Prop)
+  (trans2: S2 -> L2 -> S2 -> Prop)
+  tr1 tr2 :
+  traces_match Rℓ Rs trans1 trans2 tr1 tr2 ↔
+    traces_match (flip Rℓ) (flip Rs) trans2 trans1 tr2 tr1.
+Proof.
+  split.
+  - revert tr1 tr2. cofix CH.
+    intros tr1 tr2 Hmatch. inversion Hmatch; simplify_eq.
+    { by constructor. }
+    constructor; [done..|].
+    by apply CH.
+  - revert tr1 tr2. cofix CH.
+    intros tr1 tr2 Hmatch. inversion Hmatch; simplify_eq.
+    { by constructor. }
+    constructor; [done..|].
+    by apply CH.
+Qed.
+
+Lemma traces_match_compose {L1 L2 L3 S1 S2 S3: Type}
+    {Rℓ12 Rs12 Rℓ23 Rs23 trans1 trans2 trans3}
+    (tr1 : trace S1 L1) (tr2 : trace S2 L2) (tr3 : trace S3 L3):
+    traces_match Rℓ12 Rs12 trans1 trans2 tr1 tr2 →
+    traces_match Rℓ23 Rs23 trans2 trans3 tr2 tr3 →
+    traces_match 
+      (fun l1 l3 => exists l2, Rℓ12 l1 l2 /\ Rℓ23 l2 l3)
+      (fun s1 s3 => exists s2, Rs12 s1 s2 /\ Rs23 s2 s3)
+      trans1 trans3
+      tr1 tr3
+  .
+Proof using.
+  intros *. revert tr1 tr2 tr3.
+  cofix CIH.
+  intros tr1. destruct tr1. 
+  { simpl. intros. inversion H. subst. inversion H0. subst.
+    constructor. eauto. }
+  intros. inversion H. subst. inversion H0. subst.
+  constructor; eauto.
+Qed.
+
+
 Section execs_and_traces.
   Context {S L: Type}.
 
@@ -206,7 +436,7 @@ Section execs_and_traces.
     revert fl il. cofix CH. intros s il.
     rewrite (trace_unfold_fold (to_trace _ il)). destruct il as [| [ℓ x]?]; simpl in *.
     - by econstructor.
-    - econstructor. have ->: x = trace_last (trace_extend s ℓ x) by done.
+    - econstructor.
       apply CH.
   Qed.
 
@@ -247,237 +477,19 @@ Definition oless (a b : option nat) : Prop :=
 Lemma oleq_oless a b : oless a b -> oleq a b.
 Proof. destruct a; destruct b=>//. unfold oless, oleq. lia. Qed.
 
+Global Instance oless_dec: forall x y, Decision (oless x y). 
+Proof. 
+  destruct x, y; simpl; solve_decision. 
+Qed. 
 
-Section dec_unless.
-  Context {St S' L L': Type}.
-  Context (Us: St -> S').
-  Context (Ul: L -> option L').
-
-  Definition dec_unless Ψ (tr: trace St L) :=
-    ∀ n, match after n tr with
-         | Some ⟨ _ ⟩ | None => True
-         | Some (s -[ℓ]-> tr') =>
-           (∃ ℓ', Ul ℓ = Some ℓ') ∨
-           (Ψ (trfirst tr') < Ψ s ∧ Us s = Us (trfirst tr'))
-         end.
-
-  Lemma dec_unless_next Ψ s ℓ tr (Hdec: dec_unless Ψ (s -[ℓ]-> tr)): dec_unless Ψ tr.
-  Proof.
-    intros n. specialize (Hdec (n+1)). rewrite (after_sum 1) // in Hdec.
-  Qed.
-
-End dec_unless.
-
-Section destuttering.
-  Context {St S' L L': Type}.
-  Context (Us: St -> S').
-  Context (Ul: L -> option L').
-
-  Inductive upto_stutter_ind (upto_stutter_coind: trace St L -> trace S' L' -> Prop):
-    trace St L -> trace S' L' -> Prop :=
-  | upto_stutter_singleton s:
-      upto_stutter_ind upto_stutter_coind ⟨s⟩ ⟨Us s⟩
-  | upto_stutter_stutter btr str s ℓ:
-      Ul ℓ = None ->
-      (* (Us s = Us (trfirst btr) -> (or something like this...?) *)
-      Us s = Us (trfirst btr) ->
-      Us s = trfirst str ->
-      upto_stutter_ind upto_stutter_coind btr str ->
-      upto_stutter_ind upto_stutter_coind (s -[ℓ]-> btr) str
-  | upto_stutter_step btr str s ℓ s' ℓ':
-      Us s = s' ->
-      Ul ℓ = Some ℓ' ->
-      upto_stutter_coind btr str ->
-      upto_stutter_ind upto_stutter_coind (s -[ℓ]-> btr) (s' -[ℓ']-> str).
-
-  Definition upto_stutter := paco2 upto_stutter_ind bot2.
-
-  Lemma upto_stutter_mono :
-    monotone2 (upto_stutter_ind).
-  Proof.
-    unfold monotone2. intros x0 x1 r r' IN LE.
-    induction IN; try (econstructor; eauto; done).
-  Qed.
-  Hint Resolve upto_stutter_mono : paco.
-
-  Lemma upto_stutter_after {btr str} n {str'}:
-    upto_stutter btr str ->
-    after n str = Some str' ->
-    ∃ n' btr', after n' btr = Some btr' ∧ upto_stutter btr' str'.
-  Proof.
-    have Hw: ∀ (P: nat -> Prop), (∃ n, P (S n)) -> (∃ n, P n).
-    { intros P [x ?]. by exists (S x). }
-    revert btr str str'. induction n as [|n IH]; intros btr str str' Hupto Hafter.
-    { injection Hafter => <-. clear Hafter. exists 0, btr. done. }
-    revert str' Hafter. punfold Hupto. induction Hupto as
-        [s|btr str s ℓ HUl HUs1 HUs2 Hind IHH|btr str s ℓ s' ℓ' ?? Hind].
-    - intros str' Hafter. done.
-    - intros str' Hafter.
-      apply Hw. simpl. by apply IHH.
-    - intros str' Hafter. simpl in Hafter.
-      apply Hw. simpl. eapply IH =>//.
-      by destruct Hind.
-  Qed.
-
-  Lemma upto_stutter_after_None {btr str} n:
-    upto_stutter btr str ->
-    after n str = None ->
-    ∃ n', after n' btr = None.
-  Proof.
-    have Hw: ∀ (P: nat -> Prop), (∃ n, P (S n)) -> (∃ n, P n).
-    { intros P [x ?]. by exists (S x). }
-    revert btr str. induction n as [|n IH]; intros btr str Hupto Hafter.
-    { exists 0. done. }
-    revert Hafter. punfold Hupto. induction Hupto as
-        [s|btr str s ℓ HUl HUs1 HUs2 Hind IHH|btr str s ℓ s' ℓ' ?? Hind].
-    - intros Hafter. by exists 1.
-    - intros Hafter.
-      apply Hw. simpl. by apply IHH.
-    - intros Hafter. simpl in Hafter.
-      apply Hw. simpl. eapply IH =>//.
-      by destruct Hind.
-  Qed.
+Global Instance oleq_dec: forall x y, Decision (oleq x y). 
+Proof. 
+  destruct x, y; simpl; solve_decision. 
+Qed. 
 
-  Lemma upto_stutter_infinite_trace tr1 tr2 :
-    upto_stutter tr1 tr2 → infinite_trace tr1 → infinite_trace tr2.
-  Proof.
-    intros Hstutter Hinf n.
-    revert tr1 tr2 Hstutter Hinf.
-    induction n as [|n IHn]; intros tr1 tr2 Hstutter Hinf.
-    - punfold Hstutter.
-    - punfold Hstutter.
-      induction Hstutter.
-      + specialize (Hinf (1 + n)).
-        rewrite after_sum' in Hinf. simpl in *. apply is_Some_None in Hinf. done.
-      + apply IHHstutter.
-        intros m. specialize (Hinf (1 + m)).
-        rewrite after_sum' in Hinf. simpl in *. done.
-      + simpl. eapply (IHn btr str); [by destruct H1|].
-        intros m. specialize (Hinf (1 + m)).
-        rewrite after_sum' in Hinf. simpl in *. done.
-  Qed.
-
-  Program Fixpoint destutter_once_step N Ψ (btr: trace St L) :
-    Ψ (trfirst btr) < N →
-    dec_unless Us Ul Ψ btr →
-    S' + (S' * L' * { btr' : trace St L | dec_unless Us Ul Ψ btr'}) :=
-    match N as n return
-          Ψ (trfirst btr) < n →
-          dec_unless Us Ul Ψ btr →
-          S' + (S' * L' * { btr' : trace St L | dec_unless Us Ul Ψ btr'})
-    with
-    | O => λ Hlt _, False_rect _ (Nat.nlt_0_r _ Hlt)
-    | S N' =>
-      λ Hlt Hdec,
-      match btr as z return btr = z → S' + (S' * L' * { btr' : trace St L | dec_unless Us Ul Ψ btr'}) with
-      | tr_singl s => λ _, inl (Us s)
-      | tr_cons s l btr' =>
-        λ Hbtreq,
-        match Ul l as z return Ul l = z → S' + (S' * L' * { btr' : trace St L | dec_unless Us Ul Ψ btr'}) with
-        | Some l' => λ _, inr (Us s, l', exist _ btr' _)
-        | None => λ HUll, destutter_once_step N' Ψ btr' _ _
-        end eq_refl
-      end eq_refl
-    end.
-  Next Obligation.
-  Proof.
-    intros _ Ψ btr N' Hlt Hdec s l btr' -> l' HUll; simpl.
-    eapply dec_unless_next; done.
-  Qed.
-  Next Obligation.
-  Proof.
-    intros _ Ψ btr N' Hlt Hdec s l btr' -> HUll; simpl in *.
-    pose proof (Hdec 0) as [[? ?]|[? ?]]; [congruence|lia].
-  Qed.
-  Next Obligation.
-  Proof.
-    intros _ Ψ btr N' Hlt Hdec s l btr' -> HUll; simpl.
-    eapply dec_unless_next; done.
-  Qed.
-
-  CoFixpoint destutter_gen Ψ N (btr: trace St L) :
-    Ψ (trfirst btr) < N ->
-    dec_unless Us Ul Ψ btr → trace S' L' :=
-    λ Hlt Hdec,
-    match destutter_once_step N Ψ btr Hlt Hdec with
-    | inl s' => tr_singl s'
-    | inr (s', l', z) => tr_cons s' l' (destutter_gen Ψ  (S (Ψ (trfirst $ proj1_sig z)))
-                                                 (proj1_sig z) (Nat.lt_succ_diag_r _) (proj2_sig z))
-    end.
-
-  Definition destutter Ψ (btr: trace St L) :
-    dec_unless Us Ul Ψ btr → trace S' L' :=
-    λ Hdec,
-    destutter_gen Ψ (S (Ψ (trfirst btr))) btr (Nat.lt_succ_diag_r _) Hdec.
-
-  Lemma destutter_same_Us N Ψ btr Hlt Hdec:
-    match destutter_once_step N Ψ btr Hlt Hdec with
-    | inl s' | inr (s', _, _) => Us (trfirst btr) = s'
-    end.
-  Proof.
-    revert btr Hlt Hdec. induction N as [|N]; first lia.
-    intros btr Hlt Hdec. simpl.
-    destruct btr as [s|s ℓ btr']; first done.
-    generalize (destutter_once_step_obligation_1 Ψ (s -[ ℓ ]-> btr') N
-                Hlt Hdec s ℓ btr' eq_refl).
-    generalize (destutter_once_step_obligation_2 Ψ (s -[ ℓ ]-> btr') N Hlt Hdec s ℓ btr' eq_refl).
-    generalize (destutter_once_step_obligation_3 Ψ (s -[ ℓ ]-> btr') N Hlt Hdec s ℓ btr' eq_refl).
-    intros HunlessNone HltNone HdecSome.
-    destruct (Ul ℓ) as [ℓ'|] eqn:Heq; cbn; first done.
-    unfold dec_unless in Hdec.
-    destruct (Hdec 0) as [[??]|[? Hsame]]; first congruence.
-    rewrite Hsame. apply IHN.
-  Qed.
-
-  Lemma destutter_spec_ind N Ψ (btr: trace St L) (Hdec: dec_unless Us Ul Ψ btr)
-    (Hlt: Ψ (trfirst btr) < N):
-    upto_stutter btr (destutter_gen Ψ N btr Hlt Hdec).
-  Proof.
-    revert N btr Hlt Hdec.
-    pcofix CH. pfold.
-    induction N.
-    { intros; lia. }
-    intros btr Hlt Hdec.
-    rewrite (trace_unfold_fold (destutter_gen _ _ _ _ _)).
-    destruct btr as [s|s ℓ btr'].
-    { simpl in *. econstructor. }
-    cbn.
-    generalize (destutter_once_step_obligation_1 Ψ (s -[ ℓ ]-> btr') N
-                Hlt Hdec s ℓ btr' eq_refl).
-    generalize (destutter_once_step_obligation_2 Ψ (s -[ ℓ ]-> btr') N Hlt Hdec s ℓ btr' eq_refl).
-    generalize (destutter_once_step_obligation_3 Ψ (s -[ ℓ ]-> btr') N Hlt Hdec s ℓ btr' eq_refl).
-    intros HunlessNone HltNone HdecSome.
-    destruct (Ul ℓ) as [ℓ'|] eqn:Heq; cbn.
-    - econstructor 3 =>//. right. apply (CH (S (Ψ $ trfirst btr'))).
-    - econstructor 2=>//.
-      + destruct (Hdec 0) as [[??]|[??]];congruence.
-      + have ?: Us s = Us (trfirst btr').
-        { destruct (Hdec 0) as [[??]|[? Hsame]]; congruence. }
-        have HH := destutter_same_Us N Ψ btr' (HltNone eq_refl) (HunlessNone eq_refl).
-        destruct (destutter_once_step N Ψ btr' (HltNone eq_refl) (HunlessNone eq_refl)) as
-            [|[[??][??]]]eqn:Heq'; simpl in *; congruence.
-      + rewrite -trace_unfold_fold.
-        specialize (IHN btr' (HltNone eq_refl) (HunlessNone eq_refl)).
-        match goal with
-          [H : context[upto_stutter_ind]  |- ?Y] => let X := type of H in
-                          suffices <-: X <-> Y; first done
-        end.
-        f_equiv.
-        rewrite {1}(trace_unfold_fold (destutter_gen _ _ _ _ _)) /= -trace_unfold_fold //.
-  Qed.
-
-  Lemma destutter_spec Ψ (btr: trace St L) (Hdec: dec_unless Us Ul Ψ btr):
-    upto_stutter btr (destutter Ψ btr Hdec).
-  Proof. eapply destutter_spec_ind. Qed.
-
-  Lemma can_destutter Ψ (btr: trace St L) (Hdec: dec_unless Us Ul Ψ btr):
-    ∃ str, upto_stutter btr str.
-  Proof. exists (destutter Ψ btr Hdec). apply destutter_spec. Qed.
-
-End destuttering.
 
 (* TODO: Does this belong here? *)
-(* Adapted from Arthur Azevedo De Amorim *)
+(** Adapted from Arthur Azevedo De Amorim *)
 Section lex_ind.
   Section Lexicographic.
 
@@ -578,9 +590,11 @@ Section addition_monoid.
   Qed.
 End addition_monoid.
 
-(* Classical *)
+(** Classical *)
+
+From Stdlib Require Import Logic.Classical_Prop.
+
 
-Require Import Coq.Logic.Classical.
 Section infinite_or_finite.
   Context {St L: Type}.
 
@@ -589,7 +603,7 @@ Section infinite_or_finite.
   Proof.
     destruct (classic (infinite_trace tr)) as [|Hni]; first by eauto.
     rewrite /infinite_trace in Hni.
-    apply not_all_ex_not in Hni. destruct Hni as [n Hni%eq_None_not_Some].
+    apply not_forall_exists_not in Hni. destruct Hni as [n Hni%eq_None_not_Some].
     by right; exists n.
   Qed.
 
diff --git a/fairness/locales_helpers.v b/fairness/locales_helpers.v
new file mode 100644
index 0000000..5c21de5
--- /dev/null
+++ b/fairness/locales_helpers.v
@@ -0,0 +1,63 @@
+From trillium.program_logic Require Import language adequacy.
+From fairness Require Import utils.
+
+Section XX.
+  Context `{Countable (locale Λ)}.
+
+  Notation "'Tid'" := (locale Λ). 
+
+  (* TODO: unify with existing locales_of_list_from_locale_from, 
+     remove restriction for Λ *)
+
+  Lemma locales_of_list_from_locale_from' tp0 tp1 ζ:
+    ζ ∈ locales_of_list_from tp0 tp1 (Λ := Λ) ->
+    is_Some (from_locale_from tp0 tp1 ζ).
+  Proof.
+    clear -tp0 tp1 ζ.
+    revert tp0; induction tp1 as [|e1 tp1 IH]; intros tp0.
+    { simpl. intros H. inversion H. }
+    simpl.
+    rewrite /locales_of_list_from /=. intros.
+    destruct (decide (locale_of tp0 e1 = ζ)); simplify_eq; first set_solver.
+    apply elem_of_cons in H as [?| ?]; [done| ].
+    set_solver.
+  Qed.
+
+  Lemma locale_step_from_locale_src `{EqDecision (expr Λ)} c1 c2 ζ:
+    locale_step c1 (Some ζ) c2 →
+    is_Some(from_locale c1.1 ζ).
+  Proof.
+    intros Hstep. inversion Hstep; simplify_eq=>//.
+    rewrite /from_locale. rewrite from_locale_from_Some; try done.
+    apply prefixes_from_spec; eauto.
+  Qed. 
+
+  Definition locales_of_cfg (c: cfg Λ): gset (locale Λ) :=
+    list_to_set (locales_of_list c.1).
+
+  Definition locales_of_cfg_singleton e σ:
+    locales_of_cfg ([e], σ) = {[ locale_of [] e ]}.
+  Proof.
+    rewrite /locales_of_cfg. simpl. set_solver.
+  Qed.
+
+  Lemma locales_of_cfg_Some τ tp σ:
+    τ ∈ locales_of_cfg (tp, σ) <-> is_Some (from_locale tp τ).
+  Proof.
+    rewrite /locales_of_cfg. simpl. rewrite elem_of_list_to_set.
+    split. 
+    - apply locales_of_list_from_locale_from'.
+    - apply locales_of_list_from_locale_from. 
+  Qed.
+
+  Definition step_fork (c1 c2: cfg Λ): option (locale Λ) :=
+    let diff := locales_of_cfg c2 ∖ locales_of_cfg c1 in
+    gset_pick diff. 
+   
+  Definition extr_last_fork (extr: execution_trace Λ): option (locale Λ) :=
+    match extr with
+    | {tr[ _ ]} => None
+    | extr' :tr[oζ]: c' => step_fork (trace_last extr') c'
+    end. 
+
+End XX.
diff --git a/fairness/nat_omega.v b/fairness/nat_omega.v
new file mode 100644
index 0000000..c518d8f
--- /dev/null
+++ b/fairness/nat_omega.v
@@ -0,0 +1,256 @@
+(** * Natural numbers with infinity *)
+(** Adapted from HahnOmega in coq-hahn library  *)
+
+From iris.proofmode Require Import tactics.
+From Stdlib.Init Require Import Peano.
+
+Set Implicit Arguments.
+
+Inductive nat_omega := NOinfinity | NOnum (n: nat).
+
+Ltac lia_NO len := destruct len; [done| simpl in *; lia]. 
+Ltac lia_NO' len := destruct len; simpl in *; try (done || lia). 
+
+Global Instance nomega_eqdec: EqDecision nat_omega.
+Proof. solve_decision. Qed. 
+
+Module NOmega.
+
+  Definition t := nat_omega.
+
+  Definition zero := NOnum 0.
+
+  Definition one := NOnum 1.
+
+  Definition two := NOnum 2.
+
+  Definition succ n :=
+    match n with
+    | NOinfinity => NOinfinity
+    | NOnum n => NOnum (S n)
+    end.
+
+  Definition pred n :=
+    match n with
+    | NOinfinity => NOinfinity
+    | NOnum n => NOnum (Nat.pred n)
+    end.
+
+  Definition add n m :=
+    match n, m with
+    | NOnum n, NOnum m => NOnum (n + m)
+    | _, _ => NOinfinity
+    end.
+
+  Definition double n :=
+    match n with
+    | NOnum n => NOnum (Nat.double n)
+    | _ => NOinfinity
+    end.
+
+  Definition sub n m :=
+    match n, m with
+    | NOnum n, NOnum m => NOnum (n - m)
+    | NOnum n, NOinfinity => NOnum 0
+    | NOinfinity, _ => NOinfinity
+    end.
+
+  Definition eqb n m :=
+    match n, m with
+    | NOnum n, NOnum m => Nat.eqb n m
+    | NOinfinity, NOinfinity => true
+    | _, _ => false
+    end.
+
+  Definition ltb n m :=
+    match n, m with
+    | NOnum n, NOnum m => Nat.ltb n m
+    | NOnum n, NOinfinity => true
+    | NOinfinity, _ => false
+    end.
+
+  Definition max n m :=
+    match n, m with
+    | NOnum n, NOnum m => NOnum (Nat.max n m)
+    | _, _ => NOinfinity
+    end.
+
+  Definition min n m :=
+    match n, m with
+    | NOnum n, NOnum m => NOnum (Nat.min n m)
+    | NOnum n, NOinfinity => NOnum n
+    | NOinfinity, _ => m
+    end.
+
+  Definition le n m :=
+    match n, m with
+    | _, NOinfinity => True
+    | NOnum n, NOnum m => n <= m
+    | _, _ => False
+  end.
+
+  Global Instance nomega_le_eqdec: forall x y, Decision (le x y).
+  Proof.
+    intros. lia_NO' x; lia_NO' y; solve_decision. 
+  Qed. 
+
+  Global Instance NOmega_le_TO: TotalOrder NOmega.le. 
+  Proof. 
+    split. 
+    - split.
+      + split.
+        * intros [|]; red; lia.
+        * intros [|] [|] [|]; done || simpl; lia. 
+      + intros [|] [|]; try (done || simpl; lia). 
+        simpl. intros. f_equal. lia. 
+    - red. unfold strict. intros [|] [|]; try (done || simpl; lia). 
+      + simpl. tauto.
+      + simpl. destruct (Nat.lt_trichotomy n n0) as [?|[?|?]]; try lia.
+        subst. tauto.
+  Qed. 
+
+  Definition lt n m :=
+    match n, m with
+    | NOinfinity, _ => False
+    | NOnum n, NOnum m => n < m
+    | NOnum n, NOinfinity => True
+    end.
+
+  Definition lt_nat_l n m :=
+    match m with
+    | NOnum m => n < m
+    | NOinfinity => True
+    end.
+
+  Global Instance no_lt_nat_l_dec: forall x y, Decision (lt_nat_l x y).
+  Proof. 
+    intros. destruct y.
+    + by left.
+    + simpl. solve_decision.
+  Qed. 
+  
+  Definition sub_nat_l n m :=
+    match m with
+    | NOnum m => (n - m)
+    | NOinfinity => 0
+    end.
+
+  Lemma pred_succ n : pred (succ n) = n.
+  Proof. destruct n; eauto. Qed.
+  
+  Lemma pred_0 : pred zero = zero.
+  Proof. eauto. Qed.
+
+
+  Lemma add_0_l n : add zero n = n.
+  Proof. destruct n; eauto. Qed.
+
+  Lemma add_0_r n : add n zero = n.
+  Proof. destruct n; simpl; auto using Nat.add_0_r. Qed.
+  
+  Lemma sub_0_r n : sub n zero = n.
+  Proof. destruct n; simpl; auto using Nat.sub_0_r. Qed.
+
+  Lemma eqb_eq n m : eqb n m <-> n = m.
+  Proof.
+    destruct n, m; simpl; try done.
+    rewrite Is_true_true Nat.eqb_eq. 
+    split; congruence. 
+  Qed.
+
+  Lemma ltb_lt n m : ltb n m <-> lt n m.
+  Proof.
+    destruct n, m; simpl; try done.
+    rewrite Is_true_true Nat.ltb_lt.
+    split; congruence.
+  Qed.
+
+  Lemma max_l n m : le m n -> max n m = n.
+  Proof.
+    destruct n, m; try done.
+    simpl. intros. by rewrite Nat.max_l. 
+  Qed.
+  
+  Lemma max_r n m : le n m -> max n m = m.
+  Proof.
+    destruct n, m; try done.
+    simpl. intros. by rewrite Nat.max_r. 
+  Qed.
+
+  Lemma min_l n m : le n m -> min n m = n.
+  Proof.
+    destruct n, m; try done.
+    simpl. intros. by rewrite Nat.min_l.
+  Qed.
+  
+  Lemma min_r n m : le m n -> min n m = m.
+  Proof.
+    destruct n, m; try done.
+    simpl. intros. by rewrite Nat.min_r.
+  Qed.
+
+  Lemma lt_irrefl x : ~ lt x x.
+  Proof.
+    destruct x; eauto. simpl. lia.
+  Qed.
+
+  Lemma succ_inj n m : succ n = succ m -> n = m.
+  Proof.
+    destruct n, m; try done.
+    simpl. intros [=]. congruence. 
+  Qed.
+
+  Lemma lt_le_incl n m : lt n m -> le n m.
+  Proof.
+    destruct n, m; try done.
+    simpl. auto with arith.
+  Qed.
+
+  Lemma lt_trans n m p : lt n m -> lt m p -> lt n p.
+  Proof. 
+    destruct n, m, p; try done.
+    simpl. lia. 
+  Qed. 
+
+  Lemma le_trans n m p : le n m -> le m p -> le n p.
+  Proof. 
+    destruct n, m, p; try done.
+    simpl. lia. 
+  Qed. 
+  
+  Lemma lt_lt_nat n m k :
+    n < m -> NOmega.lt_nat_l m k -> NOmega.lt_nat_l n k.
+  Proof.
+    destruct k; try done.
+    simpl. lia. 
+  Qed.
+
+  Lemma le_lt_nat n m k :
+    n <= m -> NOmega.lt_nat_l m k -> NOmega.lt_nat_l n k.
+  Proof.
+    destruct k; try done.
+    simpl. lia. 
+  Qed.
+
+  Lemma lt_trichotomy (x y: nat_omega):
+    lt x y \/ x = y \/ lt y x. 
+  Proof using. 
+    destruct x, y; simpl; try lia; eauto.
+    pose proof (PeanoNat.Nat.lt_trichotomy n n0).
+    destruct H as [? | [? | ?]]; auto. 
+  Qed. 
+
+  Lemma le_iff_not_lt_nat (n: nat) (x: nat_omega):
+    NOmega.le x (NOnum n) <-> ¬ lt_nat_l n x. 
+  Proof. lia_NO x. Qed. 
+
+  Lemma nomega_le_lt_eq x y:
+    NOmega.le x y <-> NOmega.lt x y \/ x = y.
+  Proof.
+    lia_NO' x; lia_NO' y; try tauto.
+    - split; try done. intros [[] | [=]].
+    - rewrite Nat.le_lteq. apply Morphisms_Prop.or_iff_morphism; [done| ].
+      split; [intros -> | intros [=->]]; done.
+  Qed. 
+
+End NOmega.
diff --git a/fairness/trace_helpers.v b/fairness/trace_helpers.v
new file mode 100644
index 0000000..5ed8e0e
--- /dev/null
+++ b/fairness/trace_helpers.v
@@ -0,0 +1,200 @@
+From iris.proofmode Require Import tactics.
+From fairness Require Import trace_len trace_lookup inftraces fairness trace_utils nat_omega.
+
+Close Scope Z_scope.
+ 
+
+Section FMTraceHelpers.
+  Context {M: FairModel}.
+  Let St := fmstate M.
+  Let L := fmrole M.
+  
+  Definition set_fair_model_trace (T: L -> Prop) tr :=
+    forall ρ (Tρ: T ρ), fair_model_trace ρ tr. 
+
+  Definition strong_fair_model_trace (tr: mtrace M) (ρ: fmrole M) :=
+    forall n (EN: pred_at tr n (λ δ _, role_enabled_model ρ δ)),
+    exists m, ClassicalFacts.Minimal 
+                (fun x => pred_at tr (n+x) (λ δ ℓ, ¬ role_enabled_model ρ δ \/ 
+                                                     ℓ = Some (Some ρ))) m.
+
+
+  Lemma fair_model_trace_defs_equiv (tr: mtrace M) (ρ: fmrole M):
+    fair_model_trace ρ tr <-> strong_fair_model_trace tr ρ.
+  Proof using. 
+
+    split.
+    2: { intros FAIR. do 2 red. intros.
+         red in FAIR. specialize (FAIR n H) as [m [FAIR MIN]].
+         exists m. eapply pred_at_iff; [| apply FAIR]. 
+         intros. rewrite /role_match.
+         apply Morphisms_Prop.or_iff_morphism; [done| ].
+         split; [intros (?&->&->)|intros ->]; eauto. }
+
+    intros FAIR. red. intros.
+    red in FAIR.
+    specialize (@FAIR n). destruct FAIR; auto.
+
+    pattern x in H. eapply min_prop_dec in H as [d MIN].
+    { clear x. exists d. 
+      eapply Minimal_proper; eauto. 
+      red. intros. symmetry. 
+      apply pred_at_iff.
+      intros. rewrite /role_match.
+      apply Morphisms_Prop.or_iff_morphism; [done| ].
+      split; [intros (?&->&->)|intros ->]; eauto. }
+
+    intros.
+    eapply pred_at_dec. intros.
+    apply or_dec.
+    2: { destruct ro; [destruct o| ]. 
+         - destruct (decide (f = ρ)).
+           + subst. left. eexists. split; eauto. done.
+           + right. by intros (?&[=<-]&[=]).
+         - right. by intros (?&[=<-]&[=]).
+         - right. by intros (?&[=<-]&[=]). }
+    apply not_dec.
+    rewrite /role_enabled_model. solve_decision.
+  Qed. 
+  
+  Definition strong_fair_model_trace_alt (tr: mtrace M) (ρ: fmrole M) :=
+    forall n st (NTH: tr S!! n = Some st) (EN: role_enabled_model ρ st),
+    exists m, ClassicalFacts.Minimal (
+             fun x => (exists st', tr S!! (n + x) = Some st' /\ 
+                             ¬ role_enabled_model ρ st') \/
+                     (tr L!! (n + x) = Some (Some ρ))
+           ) m. 
+
+  Lemma strong_fair_model_trace_alt_defs_equiv (tr: mtrace M) (ρ: fmrole M):
+    strong_fair_model_trace tr ρ <-> strong_fair_model_trace_alt tr ρ.
+  Proof using. 
+    rewrite /strong_fair_model_trace /strong_fair_model_trace_alt. 
+    pose proof trace_has_len tr as [len LEN]. 
+    split; intros. 
+    - specialize (H n).
+      specialize (H ltac:(by apply pred_at_trace_lookup; eauto)). 
+      destruct H as [m [PROP MIN]]. exists m. split.
+      { apply pred_at_or in PROP as [PROP | PROP];
+          [left | right]; apply pred_at_trace_lookup in PROP as [? [??]]; eauto. }
+      intros. apply MIN. apply pred_at_trace_lookup.
+      destruct H as [(?&?&?) | STEP]; [by eauto|]. 
+      opose proof * (proj1 (label_lookup_states tr (n + k))) as [[st' ST'] _]; eauto.
+    - apply pred_at_trace_lookup in EN as [? [Tn EN]]. 
+      specialize (H _ _ Tn EN). destruct H as [m [PROP MIN]].  
+      exists m. split.
+      + apply pred_at_trace_lookup. destruct PROP as [(?&?&?) | STEP]; eauto.
+        opose proof * (proj1 (label_lookup_states tr (n + m))) as [[st' ST'] _]; eauto.
+      + intros. apply MIN. apply pred_at_or in H. destruct H as [DIS | STEP].
+        * left. apply pred_at_trace_lookup in DIS. eauto. 
+        * right. apply pred_at_trace_lookup in STEP as [?[??]]. eauto. 
+  Qed.        
+
+  
+  Section ValidTracesProperties.
+    Context {tr: mtrace M} (VALID: mtrace_valid tr). 
+
+    Local Ltac gd t := generalize dependent t.
+
+    Definition label_kept_state_gen (Ps: St -> Prop) (Pstep: St -> option L -> St -> Prop) :=
+      forall st oℓ' st' (P1: Ps st) (PSTEP: Pstep st oℓ' st') (STEP: fmtrans _ st oℓ' st'), 
+        Ps st'.
+    
+    Lemma steps_keep_state_gen i (P: St -> Prop) Pstep j
+      (Pi: exists st, tr S!! i = Some st /\ P st)    
+      (P_KEPT: label_kept_state_gen P Pstep)
+      (NOρ: forall (k: nat) st1 oℓ' st2 (IKJ: i <= k < j), tr !! k = Some (st1, Some (oℓ', st2)) -> Pstep st1 oℓ' st2):
+      forall k st' (IKJ: i <= k <= j) (KTH: tr S!! k = Some st'), P st'.
+    Proof using VALID.
+      intros k st' [IK KJ]. apply Nat.le_sum in IK as [d ->]. gd st'. induction d.
+      { rewrite Nat.add_0_r. destruct Pi as (? & ? & ?). intros. congruence. }
+      intros st'' KTH. rewrite Nat.add_succ_r -Nat.add_1_r in KTH. 
+      pose proof (trace_has_len tr) as [len LEN]. 
+      opose proof * (proj2 (trace_lookup_dom_strong  _ _ LEN (i + d))) as [st' CUR].
+      { eapply state_lookup_dom; eauto. }
+      
+      destruct CUR as (oℓ' & st''_ & CUR).
+      pose proof CUR as (PREV & CUR' & STEP)%state_label_lookup. 
+      assert (st''_ = st'') as -> by congruence.
+      red in P_KEPT. eapply P_KEPT.
+      - apply IHd; [lia| eauto].
+      - eapply NOρ; eauto. lia. 
+      - eapply trace_valid_steps'; eauto. 
+    Qed.
+    
+    Definition label_kept_state (Ps: St -> Prop) (Pl: option L -> Prop) :=
+      forall st oℓ' st' (Pst: Ps st) (Poℓ: Pl oℓ') (STEP: fmtrans _ st oℓ' st'), 
+        Ps st'.
+    
+    Definition other_step ρ: option (fmrole M) -> Prop :=
+      fun oρ' => oρ' ≠ Some ρ. 
+
+    Lemma steps_keep_state i (P: St -> Prop) Pl j
+      (Pi: exists st, tr S!! i = Some st /\ P st)    
+      (P_KEPT: label_kept_state P Pl)
+      (NOρ: forall (k: nat) oℓ' (IKJ: i <= k < j), tr L!! k = Some oℓ' -> Pl oℓ'):
+      forall k st' (IKJ: i <= k <= j) (KTH: tr S!! k = Some st'), P st'.
+    Proof using VALID.
+      intros k st' [IK KJ]. apply Nat.le_sum in IK as [d ->]. gd st'. induction d.
+      { rewrite Nat.add_0_r. destruct Pi as (? & ? & ?). intros. congruence. }
+      intros st'' KTH. rewrite Nat.add_succ_r -Nat.add_1_r in KTH. 
+      pose proof (trace_has_len tr) as [len LEN]. 
+      opose proof * (proj2 (trace_lookup_dom_strong  _ _ LEN (i + d))) as [st' CUR].
+      { eapply state_lookup_dom; eauto. }
+      destruct CUR as (oℓ' & st''_ & (PREV & CUR & STEP)%state_label_lookup).
+      assert (st''_ = st'') as -> by congruence.
+      red in P_KEPT. eapply P_KEPT.
+      - apply IHd; [lia| eauto].
+      - eapply NOρ; eauto. lia.
+      - eapply trace_valid_steps'; eauto. 
+        apply state_label_lookup. eauto. 
+    Qed.
+    
+    Lemma steps_keep_state_inf i (P: St -> Prop) Pl
+      (Pi: exists st, tr S!! i = Some st /\ P st)    
+      (P_KEPT: label_kept_state P Pl)
+      (NOρ: forall (k: nat) oℓ', i <= k -> tr L!! k = Some oℓ' -> Pl oℓ'):
+      forall k st' (IK: i <= k) (KTH: tr S!! k = Some st'), P st'.
+    Proof using VALID.
+      intros. eapply steps_keep_state; eauto.
+      intros p **. eapply (NOρ p); eauto. lia.  
+    Qed.
+
+    Lemma kept_state_fair_step (ρ: L) (P: St -> Prop)
+      (KEPT: label_kept_state P (other_step ρ))
+      (P_EN: forall st (Pst: P st), @role_enabled_model M ρ st)
+      (FAIRρ: fair_model_trace ρ tr):
+      forall i st (ITH: tr S!! i = Some st) (Pst: P st),
+      exists j st', ClassicalFacts.Minimal (fun j => i <= j /\ tr L!! j = Some $ Some ρ) j /\
+                 tr S!! j = Some st' /\ P st'.
+    Proof using VALID.
+      intros. 
+      apply fair_model_trace_defs_equiv, strong_fair_model_trace_alt_defs_equiv in FAIRρ.         
+      red in FAIRρ. edestruct FAIRρ as [d [STEP MIN]]; [eauto| ..].
+      { apply P_EN. eauto. }
+      clear FAIRρ. 
+
+      pose proof (trace_has_len tr) as [len LEN].
+      assert (NOmega.lt_nat_l (i + d) len) as DOMid.
+      { destruct STEP as [(?&?&?) | STEP]. 
+        - eapply state_lookup_dom; eauto.
+        - apply NOmega.lt_lt_nat with (m := i + d + 1); [lia| ].
+          eapply label_lookup_dom; eauto. }
+      pose proof (proj2 (state_lookup_dom _ _ LEN (i + d)) DOMid) as [st' IDTH].
+      
+      opose proof * (steps_keep_state i _ _ (i + d)) as NEXT_EN; eauto. 
+      { intros. destruct IKJ as [[v ->]%Nat.le_sum KJ]. 
+        intros ->. enough (d <= v); [lia| ]. apply MIN. eauto. }
+      { lia. }
+      
+      destruct STEP as [(st'_ & ST' & DIS') | STEP].
+      { assert (st'_ = st') as -> by congruence. 
+        destruct DIS'. apply P_EN. eauto. }
+      exists (i + d), st'. split; eauto.
+      red. split; [split; [lia| eauto]| ].
+      intros k [LE' STEP']. apply Nat.le_sum in LE' as [d' ->].
+      enough (d <= d'); [lia| ]. apply MIN. eauto.
+    Qed.
+
+  End ValidTracesProperties.
+
+End FMTraceHelpers.
diff --git a/fairness/trace_len.v b/fairness/trace_len.v
new file mode 100644
index 0000000..be97ea2
--- /dev/null
+++ b/fairness/trace_len.v
@@ -0,0 +1,192 @@
+From stdpp Require Import decidable option ssreflect.
+From Stdlib Require Import Arith.
+From fairness Require Import nat_omega inftraces utils_logic.
+Import numbers.
+
+Section TraceLen.
+  Context {St L: Type}. 
+
+  Instance NOmega_lt_le (x y: nat_omega):
+    Decision (NOmega.lt x y). 
+  Proof using. 
+    destruct x, y; simpl; solve_decision.
+  Qed. 
+
+  Definition trace_len_is (tr: trace St L) (len: nat_omega) :=
+    forall (i: nat), is_Some (after i tr) <-> NOmega.lt_nat_l i len. 
+      
+  Lemma trace_has_len (tr: trace St L):
+    exists len, trace_len_is tr len.
+  Proof using. 
+    destruct (infinite_or_finite tr) as [INF | FIN_].
+    { exists NOinfinity. red. intros. red in INF.
+      simpl. split; auto using INF. }
+    red in FIN_. 
+    assert (exists n, ClassicalFacts.Minimal (fun n => after n tr = None) n) as FIN.
+    { destruct FIN_. eapply min_prop_dec; eauto. solve_decision. }
+    clear FIN_. destruct FIN as [n [SIZE MIN]]. 
+    exists (NOnum n). red. intros i. simpl. split.
+    - intros SOME. destruct (le_lt_dec n i) as [LE| ]; auto.
+      apply Nat.le_sum in LE as [d ->].
+      rewrite after_sum' in SOME. rewrite SIZE in SOME. by destruct SOME.
+    - intros LT. destruct (is_Some_dec (after i tr)); auto.
+      specialize (MIN i). destruct (after i tr); try done.
+      specialize (MIN eq_refl). lia. 
+  Qed. 
+
+  Lemma trace_len_cons s l (tr: trace St L) (len: nat_omega)
+    (LEN: trace_len_is tr len):
+    trace_len_is (s -[l]-> tr) (NOmega.succ len).
+  Proof. 
+    unfold trace_len_is in *. intros.
+    destruct i.
+    { simpl. lia_NO' len. simpl. intuition. lia. }
+    simpl. rewrite LEN. lia_NO len.
+  Qed.
+  
+  Lemma trace_len_uniq (tr: trace St L) (len1 len2: nat_omega)
+    (LEN1: trace_len_is tr len1) (LEN2: trace_len_is tr len2):
+    len1 = len2. 
+  Proof. 
+    unfold trace_len_is in *.
+    destruct (NOmega.lt_trichotomy len1 len2) as [?|[?|?]]; auto.
+    - destruct len1; [done| ].
+      pose proof (proj2 (LEN2 n)) as L2. specialize (L2 ltac:(lia_NO len2)).
+      specialize (proj1 (LEN1 _) L2). simpl. lia.
+    - destruct len2; [done| ].
+      pose proof (proj2 (LEN1 n)) as L1. specialize (L1 ltac:(lia_NO len1)).
+      specialize (proj1 (LEN2 _) L1). simpl. lia.
+  Qed. 
+  
+  Lemma trace_len_tail s l (tr: trace St L) (len: nat_omega)
+    (LEN: trace_len_is (s -[l]-> tr) len):
+    trace_len_is tr (NOmega.pred len).
+  Proof.
+    pose proof (trace_has_len tr) as [len' LEN'].
+    pose proof (trace_len_cons s l _ _ LEN').
+    opose proof (trace_len_uniq _ _ _ LEN H) as ->; eauto.
+    lia_NO' len'. 
+  Qed.
+
+  Lemma trace_len_singleton (s: St):
+    trace_len_is ⟨ s ⟩ (NOnum 1).
+  Proof. 
+    red. intros. destruct i; simpl.
+    - rewrite is_Some_Some_True. lia.
+    - rewrite is_Some_None_False. lia.
+  Qed. 
+
+  Local Ltac gd t := generalize dependent t.
+
+  Lemma trace_len_after (tr tr': trace St L) i
+    (len: nat_omega)
+    (LEN: trace_len_is tr len)
+    (AFTER: after i tr = Some tr'):
+    trace_len_is tr' (NOmega.sub len (NOnum i)).
+  Proof.
+    gd tr. gd tr'. gd len. induction i.
+    { intros. simpl in AFTER. 
+      rewrite NOmega.sub_0_r. inversion AFTER. by subst. }
+    intros. destruct tr; [done| ].
+    simpl in AFTER.
+    pose proof (trace_len_tail _ _ _ _ LEN).
+    specialize (IHi _ _ _ H AFTER).
+    lia_NO' len. simpl in *.
+    by replace (n - S i) with (Nat.pred n - i) by lia.
+  Qed. 
+
+  Lemma trace_len_0_inv (tr: trace St L)
+    (LEN1: trace_len_is tr (NOnum 0)):
+    False. 
+  Proof.
+    pose proof (proj1 (LEN1 0)). ospecialize (H _); eauto.
+    red in H. lia. 
+  Qed. 
+
+  Lemma trace_len_gt_0 (tr: trace St L):
+    forall len, trace_len_is tr len -> NOmega.lt_nat_l 0 len.
+  Proof. 
+    intros. lia_NO' len. destruct n; [| lia].
+    by apply trace_len_0_inv in H. 
+  Qed. 
+
+  Lemma trace_len_1_inv (tr: trace St L)
+    (LEN1: trace_len_is tr (NOnum 1)):
+    exists s, tr = ⟨ s ⟩.
+  Proof. 
+    destruct tr; eauto.
+    pose proof (proj1 (LEN1 1)). ospecialize (H _); eauto.
+    red in H. lia. 
+  Qed.    
+
+  Lemma trace_len_neg (tr: trace St L) (len: nat_omega)
+    (LEN: trace_len_is tr len):
+    forall (i: nat), after i tr = None <-> NOmega.le len (NOnum i).
+  Proof. 
+    intros. specialize (LEN i).
+    destruct (after i tr).
+    - apply proj1 in LEN. ospecialize (LEN _); eauto. 
+      split; try done. lia_NO len.
+    - split; try done. intros _.
+      lia_NO' len.
+      + by destruct (proj2 LEN I).
+      + destruct (decide (n <= i)); [done| ].
+        by destruct (proj2 LEN ltac:(lia)).
+  Qed.
+
+  Lemma terminating_trace_equiv (tr: trace St L) len
+    (LEN: trace_len_is tr len):
+    terminating_trace tr <-> exists n, len = NOnum n.
+  Proof.
+    rewrite /terminating_trace. split.
+    - intros [? N]. eapply trace_len_neg in N; eauto.
+      lia_NO' len. eauto.
+    - intros [? ->]. exists x.
+      eapply trace_len_neg; eauto. simpl. lia.
+  Qed. 
+
+  Lemma infinite_trace_equiv (tr : trace St L) (len : nat_omega)
+    (LEN: trace_len_is tr len):
+    infinite_trace tr ↔ len = NOinfinity. 
+  Proof.
+    rewrite /infinite_trace. split.
+    - intros A. destruct len; [done| ].
+      eapply trace_len_neg with (i := n), proj2 in LEN. 
+      specialize (A n) as [? T]. rewrite LEN in T; [done| ]. simpl. lia. 
+    - intros -> ?. by apply LEN.
+  Qed.     
+
+End TraceLen.
+
+
+Section TracesMatch.
+
+  Lemma traces_match_same_length_impl {L1 L2 S1 S2 : Type}
+    R1 R2 step1 step2 tr1 tr2 len1 len2
+    (LEN1: trace_len_is tr1 len1)
+    (LEN2: trace_len_is tr2 len2)
+    (MATCH: @traces_match L1 L2 S1 S2 R1 R2 step1 step2 tr1 tr2)
+    (LT: NOmega.lt len1 len2):
+    False. 
+  Proof.
+    destruct len1; [done| ].
+    pose proof (proj2 (LEN2 n)) as LL2. specialize (LL2 ltac:(lia_NO len2)) as [atr2 AFTER2].
+    pose proof (traces_match_after _ _ _ _ _ _ _ _ MATCH AFTER2) as (atr1 & AFTER1 & _).
+    specialize (proj1 (LEN1 _) (mk_is_Some _ _ AFTER1)). simpl. lia.
+  Qed.
+    
+  Lemma traces_match_same_length {L1 L2 S1 S2 : Type}
+    R1 R2 step1 step2 tr1 tr2 len1 len2
+    (LEN1: trace_len_is tr1 len1)
+    (LEN2: trace_len_is tr2 len2)
+    (MATCH: @traces_match L1 L2 S1 S2 R1 R2 step1 step2 tr1 tr2):
+    len1 = len2.
+  Proof. 
+    unfold trace_len_is in *.
+    destruct (NOmega.lt_trichotomy len1 len2) as [?|[?|?]]; auto; exfalso. 
+    - eapply traces_match_same_length_impl with (tr1 := tr1) (tr2 := tr2); eauto. 
+    - apply traces_match_flip in MATCH. 
+      eapply @traces_match_same_length_impl with (tr1 := tr2) (tr2 := tr1); eauto.
+  Qed. 
+
+End TracesMatch.
diff --git a/fairness/trace_lookup.v b/fairness/trace_lookup.v
new file mode 100644
index 0000000..0d90161
--- /dev/null
+++ b/fairness/trace_lookup.v
@@ -0,0 +1,627 @@
+From fairness Require Import nat_omega trace_len inftraces trace_utils utils.
+From stdpp Require Import base ssreflect.
+From Paco Require Import paco1 paco2 pacotac.
+
+
+Section TraceLookup.
+  Context {St L: Type}. 
+
+  (** Postpone instantiation of Lookup to make the notations work properly after *)
+  Let trace_lookup_impl (tr: trace St L) i :=
+        match (after i tr) with
+        | None => None
+        | Some (tr_singl s) => Some (s, None)
+        | Some (tr_cons s l tr') => Some (s, Some (l, trfirst tr'))
+        end.
+
+
+  Definition state_lookup (tr: trace St L) (i: nat): option St := 
+    match trace_lookup_impl tr i with
+    | Some (st, _) => Some st
+    | None => None
+    end. 
+    
+  Definition label_lookup (tr: trace St L) (i: nat): option L := 
+    match trace_lookup_impl tr i with
+    | Some (_, Some (ℓ, _)) => Some ℓ
+    | _ => None
+    end.
+
+  Global Instance state_lookup_Lookup: Lookup nat St (trace St L) :=
+    fun i tr => state_lookup tr i. 
+
+  Global Instance label_lookup_Lookup: Lookup nat L (trace St L) :=
+    fun i tr => label_lookup tr i. 
+
+  Notation "tr S!! i" := (state_lookup tr i) (at level 20). 
+  Notation "tr L!! i" := (label_lookup tr i) (at level 20). 
+  
+  Global Instance trace_lookup: Lookup nat (St * option (L * St)) (trace St L) :=
+    fun i tr => trace_lookup_impl tr i.
+
+  Local Ltac unfold_lookups :=
+    rewrite /lookup /state_lookup /label_lookup /trace_lookup /trace_lookup_impl.
+
+  Lemma trace_lookup_trichotomy (tr: trace St L) (len: nat_omega)
+    (LEN: trace_len_is tr len):
+    forall i, (exists st ℓ st', tr !! i = Some (st, Some (ℓ, st')) /\ NOmega.lt_nat_l (i + 1) len) \/
+         (exists st, tr !! i = Some (st, None) /\ len = NOnum (i + 1)) \/
+         (tr !! i = None /\ NOmega.le len (NOnum i)). 
+  Proof using. 
+    intros.
+    pose proof (LEN i) as Ai. pose proof (LEN (i + 1)) as Ai'.
+    rewrite after_sum' in Ai'. 
+    destruct (NOmega_lt_le (NOnum i) len).
+    2: { right. right. apply not_iff_compat, proj2 in Ai, Ai'.
+         destruct len; simpl in *; try done.
+         specialize (Ai ltac:(lia)). specialize (Ai' ltac:(lia)). 
+         split; [| lia].
+         apply eq_None_not_Some in Ai. rewrite Ai in Ai'.
+         unfold_lookups. by rewrite Ai. }
+    apply proj2 in Ai.
+    specialize (Ai ltac:(lia_NO len)) as [ti Ai]. 
+    rewrite Ai in Ai'. 
+    destruct (decide (NOnum (i + 1) = len)) eqn:EQ'.
+    { right. left. subst. simpl in *. clear EQ'.
+      apply not_iff_compat, proj2 in Ai'. specialize (Ai' ltac:(lia)). 
+      apply eq_None_not_Some in Ai'.
+      unfold_lookups. rewrite Ai. destruct ti; eauto. congruence. }
+    assert (NOmega.lt_nat_l (i + 1) len) as LT'.
+    { destruct len; try done; simpl in *.
+      destruct (decide (i + 1 < n0)); auto. destruct n. f_equal. lia. }
+    left.
+    apply proj2 in Ai'. specialize (Ai' LT'). destruct Ai' as [ti' Ai'].
+    unfold_lookups. rewrite Ai. 
+    destruct ti; simpl in *; eauto. congruence. 
+  Qed. 
+
+  Lemma trace_lookup_dom (tr: trace St L) (len: nat_omega)
+    (LEN: trace_len_is tr len):
+    forall i, is_Some (tr !! i) <-> NOmega.lt_nat_l i len.
+  Proof using. 
+    intros i. destruct (trace_lookup_trichotomy _ _ LEN i) as [LT | [EQ | GT]].
+    - destruct LT as (?&?&?&LT&?). rewrite LT.
+      split; intros; auto.
+      destruct len; simpl in *; try lia. 
+    - destruct EQ as (?&EQ&?). subst.
+      rewrite EQ. split; simpl in *; intros; auto. lia. 
+    - destruct GT as [GT ?]. split; intros.
+      + rewrite GT in H0. by destruct H0. 
+      + lia_NO len. 
+  Qed. 
+
+  Lemma trace_lookup_dom_neg (tr : trace St L) (len : nat_omega)
+    (LEN: trace_len_is tr len):
+    ∀ i, tr !! i = None ↔ NOmega.le len (NOnum i).
+  Proof. 
+    intros. erewrite <- trace_len_neg; eauto.
+    unfold_lookups. destruct after; [destruct t| ]; done.
+  Qed. 
+
+  Lemma trace_lookup_dom_strong (tr: trace St L) (len: nat_omega)
+    (LEN: trace_len_is tr len):
+    forall i, (exists st ℓ st', tr !! i = Some (st, Some (ℓ, st'))) <-> NOmega.lt_nat_l (i + 1) len.
+  Proof using. 
+    intros i. destruct (trace_lookup_trichotomy _ _ LEN i) as [LT | [EQ | GT]].
+    - destruct LT as (?&?&?&LT&?). rewrite LT. 
+      split; intros; eauto. 
+    - destruct EQ as (?&->&?).
+      subst. split; intros. 
+      + destruct H as (?&?&?&?). congruence. 
+      + simpl in *; lia.
+    - destruct len; try done; simpl in *.
+      + tauto. 
+      + destruct GT as [-> ?]. split.
+        * by intros (?&?&?&?).
+        * lia. 
+  Qed.
+
+  Lemma trace_lookup_dom_eq (tr: trace St L) (len: nat_omega)
+    (LEN: trace_len_is tr len):
+    forall i, (exists st, tr !! i = Some (st, None)) <-> len = NOnum (i + 1). 
+  Proof using.
+    intros i. destruct (trace_lookup_trichotomy _ _ LEN i) as [LT | [EQ | GT]].
+    - destruct LT as (?&?&?&LT&?). rewrite LT. split; intros. 
+      + by destruct H0. 
+      + subst. simpl in *; lia.
+    - destruct EQ as (?&->&?). split; intros; eauto.
+    - destruct len; try done; simpl in *.
+      + tauto. 
+      + destruct GT as [-> ?]. split.
+        * by intros (?&?).
+        * intros [=]. lia. 
+  Qed.
+
+  Lemma state_label_lookup (tr: trace St L):
+    forall i st st' ℓ, 
+      tr !! i = Some (st, Some (ℓ, st')) <->
+      (tr S!! i = Some st /\ tr S!! (i + 1) = Some st' /\ tr L!! i = Some ℓ).
+  Proof using. 
+    intros. unfold_lookups. rewrite after_sum'.
+    destruct (after i tr); simpl. 
+    2: { split; [intros [=] | intros [[=] _]]. }
+    destruct t; auto.
+    { split; [intros [=] | intros [_ [[=] _]]]. }
+    simpl. split; intros.
+    - inversion H. subst. split; auto. destruct t; auto. 
+    - destruct t; destruct H as ([=] & [=] & [=]); subst; auto. 
+  Qed. 
+
+  Lemma state_lookup_dom (tr: trace St L) (len: nat_omega)
+    (LEN: trace_len_is tr len):
+    forall i, is_Some (tr S!! i) <-> NOmega.lt_nat_l i len.
+  Proof using. 
+    intros. etransitivity; [| apply trace_lookup_dom]; eauto.
+    unfold_lookups. destruct (after i tr); try done.
+    2: { split; by intros []. }
+    by destruct t. 
+  Qed. 
+
+  Lemma state_lookup_dom_neg (tr: trace St L) (len: nat_omega)
+    (LEN: trace_len_is tr len):
+    forall i, tr S!! i = None <-> NOmega.le len (NOnum i).
+  Proof using.
+    intros i.
+    pose proof (state_lookup_dom _ _ LEN i) as EQUIV.
+    apply not_iff_compat in EQUIV. 
+    by rewrite -eq_None_not_Some -NOmega.le_iff_not_lt_nat in EQUIV.
+  Qed.
+  
+  Lemma label_lookup_dom (tr: trace St L) (len: nat_omega)
+    (LEN: trace_len_is tr len):
+    forall i, is_Some (tr L!! i) <-> NOmega.lt_nat_l (i + 1) len.
+  Proof using. 
+    intros. rewrite /label_lookup.
+    pose proof (trace_lookup_trichotomy _ _ LEN i) as X. rewrite /lookup /trace_lookup in X.
+    destruct X as [LT | [EQ | GT]].  
+    - destruct LT as (?&?&?&LT&?). rewrite LT. done.
+    - destruct EQ as (?&->&->). simpl. split; [by intros []| lia]. 
+    - destruct GT as [-> ?].
+      lia_NO' len. split; [by intros []| lia]. 
+  Qed. 
+
+  Lemma state_lookup_prev (tr: trace St L) i (DOM: is_Some (tr S!! i)):
+    forall j (LE: j <= i), is_Some (tr S!! j). 
+  Proof using. 
+    intros. pose proof (trace_has_len tr) as [len ?].
+    eapply state_lookup_dom in DOM; eauto.
+    eapply state_lookup_dom; eauto. destruct len; eauto. simpl in *. lia. 
+  Qed.  
+    
+  Lemma label_lookup_prev (tr : trace St L) i (DOM: is_Some (tr L!! i)):
+    ∀ j (LE: j ≤ i), is_Some (tr L!! j).
+  Proof using.
+    intros. pose proof (trace_has_len tr) as [len ?].
+    eapply label_lookup_dom in DOM; eauto.
+    eapply label_lookup_dom; eauto. destruct len; eauto. simpl in *. lia.
+  Qed. 
+
+  Lemma label_lookup_states (tr: trace St L):
+    forall i, is_Some (tr L!! i) <-> is_Some (tr S!! i) /\ is_Some (tr S!! (i + 1)). 
+  Proof using. 
+    pose proof (trace_has_len tr) as [len ?].
+    intros. etransitivity; [apply label_lookup_dom| ]; eauto.
+    etransitivity; [symmetry; eapply state_lookup_dom| ]; eauto.
+    split; try tauto. intros. split; auto. 
+    eapply state_lookup_prev; eauto. lia.    
+  Qed.     
+
+  Lemma label_lookup_states' (tr: trace St L):
+    forall i, is_Some (tr L!! i) <-> is_Some (tr S!! (S i)). 
+  Proof using.
+    intros. rewrite label_lookup_states.
+    rewrite Nat.add_1_r. rewrite and_comm iff_and_impl_helper; [done| ].
+    intros. eapply state_lookup_prev; eauto. 
+  Qed.
+
+  Lemma next_state_lookup (tr: trace St L):
+    forall i, is_Some (tr S!! (S i)) <-> is_Some (tr S!! i) /\ is_Some (tr L!! i).
+  Proof using.
+    intros. rewrite label_lookup_states. rewrite Nat.add_1_r.
+    split; [| tauto]. intros. apply and_assoc. split; eauto.
+    rewrite and_idemp. eapply state_lookup_prev; eauto.
+  Qed. 
+  
+  Lemma pred_at_trace_lookup (tr: trace St L) (i: nat) P:
+      pred_at tr i P <-> exists st, tr S!! i = Some st /\ P st (tr L!! i). 
+  Proof using.
+    destruct (trace_has_len tr) as [len LEN].
+    rewrite /state_lookup /label_lookup /trace_lookup_impl.
+    rewrite /pred_at. destruct (after i tr) eqn:Ai.
+    2: { split; intros; try done. by destruct H as [? [[=] ?]]. }
+    destruct t; split; intros; eauto; destruct H as [? [[=] ?]]; congruence.
+  Qed. 
+
+  Lemma pred_at_trace_lookup' (tr : trace St L) (i : nat) (P : St → option L → Prop):
+    pred_at tr i P ↔ exists s step, tr !! i = Some (s, step) /\ 
+                                 P s (from_option (Some ∘ fst) None step). 
+  Proof.
+    rewrite pred_at_trace_lookup.
+    pose proof (trace_has_len tr) as [len LEN]. 
+    destruct (trace_lookup_trichotomy _ _ LEN i) as [T|[T|T]].
+    - destruct T as (?&?&?&ITH&?).
+      rewrite ITH. 
+      rewrite /lookup /trace_lookup in ITH.
+      rewrite /lookup /state_lookup /label_lookup. 
+      rewrite ITH. split. 
+      + intros (?&[=->]&?). eauto.
+      + intros (?&?&[=->]&?). subst. eauto.
+    - destruct T as (?&ITH&->).
+      rewrite ITH.
+      rewrite /lookup /trace_lookup in ITH.
+      rewrite /lookup /state_lookup /label_lookup. 
+      rewrite ITH. split.
+      + intros (?&[=->]&?). eauto.
+      + intros (?&?&[=]&?). subst. eauto.
+    - destruct T as [ITH ?]. rewrite ITH.
+      rewrite /lookup /trace_lookup in ITH.
+      rewrite /lookup /state_lookup /label_lookup. 
+      rewrite ITH. split.
+      + by intros (?&[=]&?).
+      + by intros (?&?&[=]&?).
+  Qed. 
+
+  Lemma inf_trace_lookup (tr: trace St L)
+    (INF: trace_len_is tr NOinfinity):
+    forall i, exists c1 ℓ c2, tr !! i = Some (c1, Some (ℓ, c2)).
+  Proof. 
+    intros. eapply trace_lookup_dom_strong; done.
+  Qed. 
+
+  Lemma trace_lookup_cons s l (tr: trace St L) i:
+    (s -[ l ]-> tr) !! S i = tr !! i.
+  Proof. done. Qed. 
+    
+  Lemma trace_state_lookup_simpl (tr: trace St L) i s' step s
+    (TLi: tr !! i = Some (s', step))
+    (SLi: tr S!! i = Some s):
+    s' = s.
+  Proof.
+    rewrite /state_lookup in SLi. rewrite /lookup /trace_lookup in TLi.
+    destruct (trace_lookup_impl tr i) as [[??]|]; congruence. 
+  Qed. 
+
+  Lemma trace_lookup_0_cons s ℓ (tr: trace St L):
+    (s -[ℓ]-> tr) !! 0 = Some (s, Some (ℓ, trfirst tr)).
+  Proof. done. Qed.
+
+  Lemma state_lookup_cons s l (tr: trace St L) i:
+    (s -[ l ]-> tr) S!! S i = tr S!! i.
+  Proof. done. Qed.
+    
+  Lemma label_lookup_cons s l (tr: trace St L) i:
+    (s -[ l ]-> tr) S!! S i = tr S!! i.
+  Proof. done. Qed.
+    
+  Lemma trace_label_lookup_simpl (tr: trace St L) i step ℓ
+    (TLi: tr !! i = Some step)
+    (SLi: tr L!! i = Some ℓ):
+    exists s1 s2, step = (s1, Some (ℓ, s2)). 
+  Proof.
+    rewrite /label_lookup /trace_lookup_impl in SLi. rewrite /lookup /trace_lookup /trace_lookup_impl in TLi.
+    destruct (after i tr); try done.
+    destruct t; try done. inversion SLi. inversion TLi. subst. eauto.  
+  Qed. 
+
+  Lemma state_lookup_0 (tr: trace St L):
+    tr S!! 0 = Some (trfirst tr). 
+  Proof. by destruct tr. Qed.
+
+  Lemma label_lookup_0 st ℓ (tr: trace St L):
+    (st -[ℓ]-> tr) L!! 0 = Some ℓ. 
+  Proof. done. Qed.
+
+  Lemma trace_state_lookup_simpl' (tr: trace St L) i st:
+    (exists step, tr !! i = Some step /\ fst step = st) <-> tr S!! i = Some st. 
+  Proof.
+    unfold_lookups. 
+    destruct after.
+    2: { split; [intros (?&?&?) | intros ?]; done. }
+    destruct t.
+    all: split; [intros  ([??]&?&?) | intros [=]]; simpl in *; subst.
+    all: congruence || eauto. 
+  Qed. 
+
+  Lemma trace_state_lookup (tr: trace St L) i st ostep
+    (ITH: tr !! i = Some (st, ostep)):
+    tr S!! i = Some st.
+  Proof. 
+    eapply trace_state_lookup_simpl'; eauto. 
+  Qed. 
+
+  Lemma trace_label_lookup_simpl' (tr: trace St L) i ℓ:
+    (exists s1 s2, tr !! i = Some (s1, Some (ℓ, s2))) <-> tr L!! i = Some ℓ. 
+  Proof.
+    split.
+    { intros (?&?&?%state_label_lookup). tauto. }
+    unfold_lookups. 
+    destruct after; [| done].
+    destruct t; [done| ]. intros [=->]. eauto.
+  Qed. 
+
+  Lemma trace_lookup_0_singleton (s: St):    
+     (⟨ s ⟩: trace St L) !! 0 = Some (s, None).
+  Proof. done. Qed. 
+
+  Lemma trace_lookup_0 (tr: trace St L):    
+    exists ostep, tr !! 0 = Some (trfirst tr, ostep).
+  Proof.
+    destruct tr; eauto. 
+  Qed.
+
+  Lemma trace_lookup_0_Some (tr: trace St L):
+    is_Some (tr !! 0). 
+  Proof.
+    pose proof (trace_has_len tr) as [len LEN]. 
+    eapply trace_lookup_dom; eauto.
+    eapply trace_len_gt_0; eauto. 
+  Qed.
+
+End TraceLookup.
+
+Notation "tr S!! i" := (state_lookup tr i) (at level 20). 
+Notation "tr L!! i" := (label_lookup tr i) (at level 20). 
+
+
+Section After.
+  Context {St L: Type}. 
+
+  Local Ltac unfold_lookups :=
+    rewrite /lookup /state_lookup /label_lookup /trace_lookup.
+
+  Lemma trace_lookup_after (tr atr: trace St L) (a: nat)
+    (AFTER: after a tr = Some atr):
+    forall k, atr !! k = tr !! (a + k).
+  Proof. 
+    intros. unfold_lookups. 
+    rewrite after_sum'. by rewrite AFTER.
+  Qed. 
+
+  Lemma state_lookup_after (tr atr: trace St L) (a: nat)
+    (AFTER: after a tr = Some atr):
+    forall k, atr S!! k = tr S!! (a + k).
+  Proof. 
+    intros. unfold_lookups. 
+    rewrite after_sum'. by rewrite AFTER.
+  Qed. 
+
+  Lemma label_lookup_after (tr atr: trace St L) (a: nat)
+    (AFTER: after a tr = Some atr):
+    forall k, atr L!! k = tr L!! (a + k).
+  Proof. 
+    intros. unfold_lookups. 
+    rewrite after_sum'. by rewrite AFTER.
+  Qed.
+
+  Lemma state_lookup_after_0 (tr atr : trace St L) n
+    (AFTER: after n tr = Some atr):
+    tr S!! n = Some (trfirst atr).
+  Proof. 
+    rewrite -(Nat.add_0_r n).
+    erewrite <- state_lookup_after; eauto.
+    apply state_lookup_0.
+  Qed.
+
+  Lemma state_lookup_after' (tr: trace St L) n st:
+    (exists atr, after n tr = Some atr /\ trfirst atr = st) <-> tr S!! n = Some st. 
+  Proof. 
+    destruct (after n tr) as [atr| ] eqn:AFTER.
+    2: { split; [by intros (?&?&?)| ].
+         pose proof (trace_has_len tr) as [len ?]. 
+         eintros ?%mk_is_Some%state_lookup_dom; eauto.
+         eapply trace_len_neg in AFTER; eauto. lia_NO len. }
+    erewrite state_lookup_after_0; eauto.
+    split. 
+    - intros (?&[=->]&?). congruence.
+    - intros [=]. eauto.
+  Qed. 
+
+  Lemma trace_lookup_after_strong (tr: trace St L) s1 ℓ s2 n:
+    (exists atr', after n tr = Some (s1 -[ℓ]-> atr') /\ trfirst atr' = s2) <-> tr !! n = Some (s1, Some (ℓ, s2)). 
+  Proof. 
+    destruct (after n tr) as [atr| ] eqn:AFTER.
+    2: { split; [by intros (?&?&?)| ].
+         pose proof (trace_has_len tr) as [len LEN].
+         intros NTH.
+         opose proof * (proj1 (trace_lookup_dom_strong _ _ LEN n)); eauto.
+         eapply trace_len_neg in AFTER; eauto. lia_NO' len. }
+
+    rewrite /lookup /trace_lookup AFTER. 
+    split.
+    - intros (?&[=->]&?). congruence.
+    - intros EQ. destruct atr; [congruence| ].
+      inversion EQ. subst. eauto. 
+  Qed.
+
+  Lemma trace_lookup_after_weak (tr: trace St L) s n:
+    (exists atr, after n tr = Some atr /\ trfirst atr = s) <-> exists ostep, tr !! n = Some (s, ostep). 
+  Proof. 
+    rewrite /lookup /trace_lookup.
+    destruct after.
+    2: { by split; [intros (?&?&?)| intros (?&?)]. }
+    transitivity (trfirst t = s).
+    { split; eauto. by intros (?&[=->]&?). }
+    destruct t; simpl; eauto.
+    all: split; [intros ->| intros (?&[=])]; eauto.
+  Qed.   
+
+  Lemma trace_lookup_prev (tr: trace St L) i st2 ostep
+    (ITH': tr !! S i = Some (st2, ostep)):
+    exists st1 l, tr !! i = Some (st1, Some (l, st2)).
+  Proof.
+    pose proof (trace_has_len tr) as [len LEN]. 
+    opose proof * (proj2 (trace_lookup_dom_strong _ _ LEN i)) as X.
+    { eapply trace_lookup_dom; eauto.
+      by rewrite Nat.add_1_r. }
+    destruct X as (?&?&st'&ITH).
+    enough (st' = st2).
+    { subst. eauto. }    
+    apply state_label_lookup in ITH as (?&ITH'_&?).
+    rewrite Nat.add_1_r in ITH'_.
+    symmetry. 
+    eapply trace_state_lookup_simpl; eauto.
+  Qed.
+
+End After.
+
+
+Section TracesMatch.
+  Context {L1 L2 S1 S2: Type}.
+  Context {Rℓ : L1 → L2 → Prop}.
+  Context {Rs : S1 → S2 → Prop}.
+  Context {trans1 : S1 → L1 → S1 → Prop}.
+  Context {trans2 : S2 → L2 → S2 → Prop}.  
+  
+
+  Lemma traces_match_trace_lookup_general 
+    (tr1 : trace S1 L1) (tr2 : trace S2 L2) (n : nat)
+    (MATCH: traces_match Rℓ Rs trans1 trans2 tr1 tr2):
+    match tr1 !! n, tr2 !! n with
+    | Some step1, Some step2 => 
+        Rs (fst step1) (fst step2) /\
+          match snd step1, snd step2 with 
+          | Some (ℓ1, s1'), Some (ℓ2, s2') => Rℓ ℓ1 ℓ2 /\ Rs s1' s2'
+          | None, None => True
+          | _, _ => False
+          end
+    | None, None => True
+    | _ , _ => False
+    end. 
+  Proof. 
+    pose proof (trace_has_len tr1) as [len LEN1]. pose proof (trace_has_len tr2) as [? LEN2].
+    opose proof * (traces_match_same_length _ _ _ _ tr1 tr2) as X; eauto. subst x.
+    destruct (tr1 !! n) as [[s1 step1]| ] eqn:STEP1, (tr2 !! n) as [[s2 step2]| ] eqn:STEP2. 
+    4: done. 
+    3: { eapply mk_is_Some, trace_lookup_dom in STEP2; eauto. 
+         eapply trace_lookup_dom_neg in STEP1; eauto.
+         lia_NO len. }
+    2: { eapply mk_is_Some, trace_lookup_dom in STEP1; eauto. 
+         eapply trace_lookup_dom_neg in STEP2; eauto.
+         lia_NO len. }
+
+    opose proof * (proj1 (trace_state_lookup_simpl' tr1 n s1)) as ST1; eauto.
+    opose proof * (proj1 (trace_state_lookup_simpl' tr2 n s2)) as ST2; eauto.
+    simpl in *.
+    pose proof (proj2 (state_lookup_after' _ _ _) ST1) as (atr1 & AFTER1 & A1).
+    opose proof * (traces_match_after' _ _ _ _ tr1 tr2) as X; eauto.
+    destruct X as (atr2 & AFTER2 & A2). 
+    split.
+    { apply traces_match_first in A2.
+      erewrite state_lookup_after_0 in ST1; eauto. 
+      erewrite state_lookup_after_0 in ST2; eauto.
+      congruence. }
+    destruct step1 as [[ℓ1 s1']| ], step2 as [[ℓ2 s2']| ].
+    4: done.
+    3: { opose proof * (proj1 (trace_lookup_dom_strong _ _ LEN2 n)); eauto.
+         opose proof * (proj1 (trace_lookup_dom_eq _ _ LEN1 n)); eauto.
+         lia_NO' len. inversion H0. lia. }
+    2: { opose proof * (proj1 (trace_lookup_dom_strong _ _ LEN1 n)); eauto.
+         opose proof * (proj1 (trace_lookup_dom_eq _ _ LEN2 n)); eauto.
+         lia_NO' len. inversion H0. lia. }
+    
+    apply trace_lookup_after_strong in STEP1 as (?&AFTER1'&?), STEP2 as (?&AFTER2'&?).
+    erewrite AFTER1' in AFTER1. rewrite AFTER2' in AFTER2.
+    inversion AFTER1. inversion AFTER2. subst atr1 atr2.
+    inversion A2. subst. split; eauto.
+    eapply traces_match_first; eauto.
+  Qed.
+
+  Lemma traces_match_state_lookup_1
+    (tr1 : trace S1 L1) (tr2 : trace S2 L2) (n : nat) st1
+    (MATCH: traces_match Rℓ Rs trans1 trans2 tr1 tr2)
+    (ST1: tr1 S!! n = Some st1):
+    exists st2, tr2 S!! n = Some st2 /\ Rs st1 st2.
+  Proof. 
+    apply trace_state_lookup_simpl' in ST1 as ([s1 ostep1] & NTH1 & <-).
+    pose proof (traces_match_trace_lookup_general _ _ n MATCH) as STEPS.
+    rewrite NTH1 in STEPS.
+    destruct (tr2 !! n) as [[s2 ostep2]|] eqn:NTH2; [| done]. simpl in *.
+    destruct STEPS. eexists. split; eauto.
+    eapply trace_state_lookup_simpl'; eauto.
+  Qed. 
+
+  Lemma traces_match_state_lookup_2
+    (tr1 : trace S1 L1) (tr2 : trace S2 L2) (n : nat) st2
+    (MATCH: traces_match Rℓ Rs trans1 trans2 tr1 tr2)
+    (ST2: tr2 S!! n = Some st2):
+    exists st1, tr1 S!! n = Some st1 /\ Rs st1 st2.
+  Proof. 
+    apply trace_state_lookup_simpl' in ST2 as ([s2 ostep2] & NTH2 & <-).
+    pose proof (traces_match_trace_lookup_general _ _ n MATCH) as STEPS.
+    rewrite NTH2 in STEPS.
+    destruct (tr1 !! n) as [[s1 ostep1]|] eqn:NTH1; [| done]. simpl in *.
+    destruct STEPS. eexists. split; eauto.
+    eapply trace_state_lookup_simpl'; eauto.
+  Qed.
+
+  Lemma traces_match_label_lookup_1
+    (tr1 : trace S1 L1) (tr2 : trace S2 L2) (n : nat) ℓ1
+    (MATCH: traces_match Rℓ Rs trans1 trans2 tr1 tr2)
+    (LBL1: tr1 L!! n = Some ℓ1):
+    exists ℓ2, tr2 L!! n = Some ℓ2 /\ Rℓ ℓ1 ℓ2. 
+  Proof. 
+    apply trace_label_lookup_simpl' in LBL1 as (s & s' & NTH1).
+    pose proof (traces_match_trace_lookup_general _ _ n MATCH) as STEPS.
+    rewrite NTH1 in STEPS.
+    destruct (tr2 !! n) as [[s2 ostep2]|] eqn:NTH2; [| done]. simpl in *.
+    destruct ostep2 as [[??]|]; [| tauto]. destruct STEPS as (?&?&?). 
+    eexists. split; eauto.
+    eapply trace_label_lookup_simpl'; eauto.
+  Qed.
+
+  Lemma traces_match_label_lookup_2
+    (tr1 : trace S1 L1) (tr2 : trace S2 L2) (n : nat) ℓ2
+    (MATCH: traces_match Rℓ Rs trans1 trans2 tr1 tr2)
+    (LBL2: tr2 L!! n = Some ℓ2):
+    exists ℓ1, tr1 L!! n = Some ℓ1 /\ Rℓ ℓ1 ℓ2. 
+  Proof. 
+    apply trace_label_lookup_simpl' in LBL2 as (s & s' & NTH2).
+    pose proof (traces_match_trace_lookup_general _ _ n MATCH) as STEPS.
+    rewrite NTH2 in STEPS.
+    destruct (tr1 !! n) as [[s1 ostep1]|] eqn:NTH1; [| done]. simpl in *.
+    destruct ostep1 as [[??]|]; [| tauto]. destruct STEPS as (?&?&?). 
+    eexists. split; eauto.
+    eapply trace_label_lookup_simpl'; eauto.
+  Qed.
+
+End TracesMatch. 
+
+
+Section ValidTracesProperties.
+  Context {St L: Type}.
+  Context (trans: St -> L -> St -> Prop). 
+
+  Context (tr: trace St L).
+  Hypothesis VALID: trace_valid trans tr. 
+
+  Local Ltac gd t := generalize dependent t.
+  
+  Lemma trace_valid_steps' i st ℓ st'
+    (ITH: tr !! i = Some (st, Some (ℓ, st'))):
+    trans st ℓ st'. 
+  Proof using VALID.
+    gd st. gd ℓ. gd st'. gd tr. clear dependent tr. 
+    induction i. 
+    { simpl. intros. punfold VALID. inversion VALID.
+      3: { by apply trace_valid_mono. } 
+      - subst. done.
+      - subst. inversion ITH. by subst. }
+    intros. simpl in ITH.
+    destruct tr.
+    { inversion ITH. }
+    punfold VALID; [| by apply trace_valid_mono]. 
+    inversion_clear VALID; pclearbot; auto.
+    eapply IHi; eauto. 
+  Qed.
+  
+  Lemma trace_valid_steps'' i st ℓ st'
+    (ST1: tr S!! i = Some st)
+    (ST2: tr S!! (i + 1) = Some st')
+    (LBL: tr L!! i = Some ℓ):
+    trans st ℓ st'. 
+  Proof using VALID.
+    eapply trace_valid_steps'.
+    apply state_label_lookup. eauto.
+  Qed.      
+  
+End ValidTracesProperties. 
diff --git a/fairis/trace_utils.v b/fairness/trace_utils.v
similarity index 75%
rename from fairis/trace_utils.v
rename to fairness/trace_utils.v
index 40dc554..9f8d1b3 100644
--- a/fairis/trace_utils.v
+++ b/fairness/trace_utils.v
@@ -1,6 +1,8 @@
 From stdpp Require Import option.
 From Paco Require Import paco1 paco2 pacotac.
-From trillium.fairness Require Export inftraces.
+From fairness Require Export inftraces.
+Import stdpp.ssreflect.
+From trillium Require Import traces.
 
 Definition trace_implies {S L} (P Q : S → option L → Prop) (tr : trace S L) : Prop :=
   ∀ n, pred_at tr n P → ∃ m, pred_at tr (n+m) Q.
@@ -10,8 +12,8 @@ Lemma trace_implies_after {S L : Type} (P Q : S → option L → Prop) tr tr' k
   trace_implies P Q tr → trace_implies P Q tr'.
 Proof.
   intros Haf Hf n Hp.
-  have Hh:= Hf (k+n).
-  have Hp': pred_at tr (k + n) P.
+  set (Hh:= Hf (k+n)).
+  assert (Hp': pred_at tr (k + n) P).
   { rewrite (pred_at_sum _ k) Haf /= //. }
   have [m Hm] := Hh Hp'. exists m.
   by rewrite <- Nat.add_assoc, !(pred_at_sum _ k), Haf in Hm.
@@ -21,47 +23,6 @@ Lemma trace_implies_cons {S L : Type} (P Q : S → option L → Prop) s l tr :
   trace_implies P Q (s -[l]-> tr) → trace_implies P Q tr.
 Proof. intros H. by eapply (trace_implies_after _ _ (s -[l]-> tr) tr 1). Qed.
 
-Lemma pred_at_or {S L : Type} (P1 P2 : S → option L → Prop) tr n :
-  pred_at tr n (λ s l, P1 s l ∨ P2 s l) ↔
-  pred_at tr n P1 ∨
-  pred_at tr n P2.
-Proof.
-  split.
-  - revert tr.
-    induction n as [|n IHn]; intros tr Htr.
-    + destruct tr; [done|].
-      rewrite !pred_at_0. rewrite !pred_at_0 in Htr.
-      destruct Htr as [Htr | Htr]; [by left|by right].
-    + destruct tr; [done|by apply IHn].
-  - revert tr.
-    induction n as [|n IHn]; intros tr Htr.
-    + destruct tr; [done|].
-      rewrite !pred_at_0 in Htr. rewrite !pred_at_0.
-      destruct Htr as [Htr | Htr]; [by left|by right].
-    + by destruct tr; [by destruct Htr as [Htr|Htr]|apply IHn].
-Qed.
-
-Lemma traces_match_flip {S1 S2 L1 L2}
-      (Rℓ: L1 -> L2 -> Prop) (Rs: S1 -> S2 -> Prop)
-      (trans1: S1 -> L1 -> S1 -> Prop)
-      (trans2: S2 -> L2 -> S2 -> Prop)
-      tr1 tr2 :
-  traces_match Rℓ Rs trans1 trans2 tr1 tr2 ↔
-  traces_match (flip Rℓ) (flip Rs) trans2 trans1 tr2 tr1.
-Proof.
-  split.
-  - revert tr1 tr2. cofix CH.
-    intros tr1 tr2 Hmatch. inversion Hmatch; simplify_eq.
-    { by constructor. }
-    constructor; [done..|].
-    by apply CH.
-  - revert tr1 tr2. cofix CH.
-    intros tr1 tr2 Hmatch. inversion Hmatch; simplify_eq.
-    { by constructor. }
-    constructor; [done..|].
-    by apply CH.
-Qed.
-
 Lemma traces_match_impl {S1 S2 L1 L2}
       (Rℓ1: L1 -> L2 -> Prop) (Rs1: S1 -> S2 -> Prop)
       (Rℓ2: L1 -> L2 -> Prop) (Rs2: S1 -> S2 -> Prop)
@@ -176,7 +137,7 @@ Qed.
 
 Fixpoint trace_take {S L} (n : nat) (tr : trace S L) : finite_trace S L :=
   match tr with
-  | ⟨s⟩ => {tr[s]}
+  | ⟨s⟩ => {tr[ s ]}
   | s -[ℓ]-> r => match n with
                   | 0 => {tr[s]}
                   | S n => (trace_take n r) :tr[ℓ]: s
@@ -215,14 +176,6 @@ Proof.
   - by apply IHn.
 Qed.
 
-Lemma pred_at_impl {S L} (tr:trace S L) n (P Q : S → option L → Prop) :
-  (∀ s l, P s l → Q s l) → pred_at tr n P → pred_at tr n Q.
-Proof.
-  rewrite /pred_at. intros HPQ HP.
-  destruct (after n tr); [|done].
-  by destruct t; apply HPQ.
-Qed.
-
 Lemma pred_at_neg {S L} (tr:trace S L) n (P : S → option L → Prop) :
   is_Some (after n tr) →
   ¬ pred_at tr n P ↔ pred_at tr n (λ s l, ¬ P s l).
@@ -314,34 +267,9 @@ Lemma trace_eventually_cons {S T} s l (tr : trace S T) P :
   trace_eventually tr P → trace_eventually (s -[l]-> tr) P.
 Proof. intros [n HP]. by exists (Datatypes.S n). Qed.
 
-Lemma trace_eventually_stutter_preserves 
-      {St S' L L': Type} (Us: St -> S') (Ul: L -> option L')
-      tr1 tr2 P :
-  upto_stutter Us Ul tr1 tr2 →
-  trace_eventually tr2 P →
-  trace_eventually tr1 (λ s l, P (Us s) (l ≫= Ul)).
-Proof.
-  intros Hstutter [n Heventually].
-  revert tr1 tr2 Hstutter Heventually.
-  induction n as [|n IHn]; intros tr1 tr2 Hstutter Heventually.
-  - punfold Hstutter; [|apply upto_stutter_mono].
-    induction Hstutter.
-    + rewrite /pred_at in Heventually. simpl in *. exists 0. rewrite /pred_at. simpl in *. done.
-    + destruct (IHHstutter Heventually) as [n Heventually'].
-      exists (1 + n). rewrite /pred_at. rewrite after_sum'. simpl.
-      done.
-    + rewrite /pred_at in Heventually. simpl in *. exists 0. rewrite /pred_at. simpl.
-      simplify_eq. rewrite H0. done.
-  - punfold Hstutter; [|apply upto_stutter_mono].
-    induction Hstutter.
-    + rewrite /pred_at in Heventually. simpl in *. exists 0. rewrite /pred_at. simpl in *. done.
-    + destruct (IHHstutter Heventually) as [n' Heventually'].
-      exists (1 + n'). rewrite /pred_at. rewrite after_sum'. simpl.
-      done.
-    + apply trace_eventually_cons.
-      assert (pred_at str n P) as Heventually'.
-      { rewrite /pred_at in Heventually.
-        simpl in *. done. }
-      eapply IHn; [|done].
-      rewrite /upaco2 in H1. destruct H1; [done|done].
-Qed.
+Definition to_trace_trfirst {S L : Type}
+  (s: S) (il: inflist (L * S)):
+  trfirst (to_trace s il) = s.
+Proof. 
+  destruct il as [| [??]]; done.
+Qed. 
diff --git a/fairness/traces_match.v b/fairness/traces_match.v
new file mode 100644
index 0000000..4b12392
--- /dev/null
+++ b/fairness/traces_match.v
@@ -0,0 +1,100 @@
+From iris.proofmode Require Import tactics.
+From trillium Require Import language.
+From fairness Require Import inftraces fairness. 
+
+
+Section TracesMatch.
+  Context `{Λ: language}.
+  Context `{M: Model}. 
+
+  Let model_trace := trace (mstate M) (mlabel M).
+
+  Context (evolution_pred: cfg Λ -> olocale Λ → cfg Λ → 
+                           M → mlabel M → M -> Prop). 
+
+  Context (state_rel: cfg Λ -> mstate M -> Prop).
+  Context (lbl_rel: olocale Λ -> mlabel M -> Prop).
+  Hypothesis (LBL_REL_EV: forall c1 oζ c2 δ1 ℓ δ2,
+                 evolution_pred c1 oζ c2 δ1 ℓ δ2 ->
+                 lbl_rel oζ ℓ).
+  Hypothesis (STEP_EV: forall c1 oζ c2 δ1 ℓ δ2,
+                 evolution_pred c1 oζ c2 δ1 ℓ δ2 ->
+                 mtrans δ1 ℓ δ2).
+
+  Definition exaux_traces_match:
+    extrace Λ → model_trace → Prop :=
+    traces_match lbl_rel
+      state_rel
+      locale_step
+      (@mtrans M).
+
+  Lemma valid_inf_system_trace_implies_traces_match_strong'
+        (φ : execution_trace Λ -> auxiliary_trace M -> Prop)
+        ex atr iex iatr progtr (auxtr : model_trace):
+    (forall (ex: execution_trace Λ) (atr: auxiliary_trace M),
+        φ ex atr -> state_rel (trace_last ex) (trace_last atr)) ->
+    (forall (ex: execution_trace Λ) (oζ: olocale Λ) (c: cfg Λ) 
+       (atr: auxiliary_trace M) (ℓ: mlabel M) (δ: mstate M),
+        φ (ex :tr[ oζ ]: c) (atr :tr[ ℓ ]: δ) -> 
+        evolution_pred (trace_last ex) oζ c (trace_last atr) ℓ δ) ->
+    exec_trace_match ex iex progtr ->
+    exec_trace_match atr iatr auxtr ->
+    valid_inf_system_trace φ ex atr iex iatr ->
+    traces_match lbl_rel
+                 state_rel
+                 locale_step
+                 (@mtrans M) progtr auxtr.
+  Proof.
+    intros Hφ1 Hφ2.
+    revert ex atr iex iatr auxtr progtr. cofix IH.
+    intros ex atr iex iatr auxtr progtr Hem Ham Hval.
+    inversion Hval as [?? Hphi |ex' atr' c [? σ'] δ' iex' iatr' oζ ℓ Hphi [=] ? Hinf]; simplify_eq.
+    - inversion Hem; inversion Ham. econstructor; eauto.
+      pose proof (Hφ1 ex atr Hphi).
+      by simplify_eq. 
+    - inversion Hem; inversion Ham. subst.
+      pose proof (valid_inf_system_trace_inv _ _ _ _ _ Hinf) as Hphi'.
+      specialize (Hφ2 _ _ _ _ _ _ Hphi') as STEP.
+      econstructor.
+      + eapply LBL_REL_EV; eauto.
+      + eauto.
+      + match goal with
+        | [H: exec_trace_match _ iex' _ |- _] => inversion H; clear H; simplify_eq
+        end; done.
+      + match goal with
+        | [H: exec_trace_match _ iatr' _ |- _] => inversion H; clear H; simplify_eq
+        end; eapply STEP_EV; eauto.
+      + eapply IH; eauto.
+  Qed.
+
+
+  Definition valid_state_evolution_fairness
+             (extr : execution_trace Λ) (auxtr : auxiliary_trace M) :=
+    match extr, auxtr with
+    | (extr :tr[oζ]: (es, σ)), auxtr :tr[ℓ]: δ =>
+        evolution_pred (trace_last extr) oζ (es, σ) (trace_last auxtr) ℓ δ
+    | _, _ => True
+    end.
+
+  (* TODO: this should already be covered by .._strong' lemma above *)
+  Lemma valid_inf_system_trace_implies_traces_match
+        (φ : execution_trace Λ -> auxiliary_trace M -> Prop)
+        ex atr iex iatr progtr (auxtr : model_trace):
+    (forall (ex: execution_trace Λ) (atr: auxiliary_trace M),
+        φ ex atr -> state_rel (trace_last ex) (trace_last atr)) ->
+    (forall (ex: execution_trace Λ) (atr: auxiliary_trace M),
+        φ ex atr -> valid_state_evolution_fairness ex atr) ->
+    exec_trace_match ex iex progtr ->
+    exec_trace_match atr iatr auxtr ->
+    valid_inf_system_trace φ ex atr iex iatr ->
+    traces_match lbl_rel
+                 state_rel
+                 locale_step
+                 (@mtrans M) progtr auxtr. 
+  Proof.
+    intros. eapply valid_inf_system_trace_implies_traces_match_strong'; eauto.
+    intros. apply H0 in H4. red in H4. by destruct c. 
+  Qed. 
+
+
+End TracesMatch.
diff --git a/fairness/utils.v b/fairness/utils.v
new file mode 100644
index 0000000..f6c14ee
--- /dev/null
+++ b/fairness/utils.v
@@ -0,0 +1,164 @@
+From iris.algebra Require Import gmap gset.
+From iris.proofmode Require Import tactics.
+From trillium.prelude Require Import quantifiers finitary.
+From fairness Require Export utils_logic utils_sets utils_maps utils_relations.
+
+
+(* TODO: move these lemmas to appropriate places *)
+
+Section Disjoint.
+
+  Lemma disjoint_subseteq:
+    ∀ {A C : Type} {H : ElemOf A C} {H0 : Empty C} {H1 : Singleton A C}
+      {H2 : Union C} {H3 : Intersection C} {H4 : Difference C},
+      `{Set_ A C} → ∀ X1 X2 Y1 Y2: C, X1 ⊆ Y1 -> X2 ⊆ Y2 → Y1 ## Y2 -> X1 ## X2.
+  Proof. intros. set_solver. Qed.
+
+End Disjoint.
+
+
+Lemma map_img_sets_split_helper `{Countable K, Countable A} (k: K) (m: gmap K (gset A)):
+  flatten_gset $ map_img m = default ∅ (m !! k) ∪ (flatten_gset $ map_img (delete k m)).
+Proof using.
+  rewrite {1}(map_split m k). rewrite map_img_union_disjoint_L.
+  2: { destruct (m !! k) eqn:KTH; simpl. 
+       all: apply map_disjoint_dom; set_solver. }
+  rewrite flatten_gset_union. f_equal.
+  destruct (m !! k) eqn:KTH; simpl.
+  - by rewrite map_img_singleton_L flatten_gset_singleton.
+  - by rewrite map_img_empty_L flatten_gset_empty.
+Qed. 
+
+Section bigop_utils.
+  Context `{Monoid M o}.
+  Context `{Countable K}.
+
+  Lemma big_opMS (g: gset K) (P: K -> M):
+    ([^ o set] x ∈ g, P x) ≡ [^ o map] x ↦ y ∈ (mapset_car g), P x.
+  Proof.
+    rewrite big_opS_elements /elements /gset_elements /mapset_elements.
+    rewrite big_opM_map_to_list.
+    destruct g as [g]. simpl. rewrite big_opL_fmap.
+    f_equiv.
+  Qed.
+End bigop_utils.
+
+
+Section bigop_utils.
+  Context `{Countable K} {A : cmra}.
+  Implicit Types m : gmap K A.
+  Implicit Types i : K.
+
+  Lemma gset_to_gmap_singletons (a : A) (g : gset K):
+    ([^op set] x ∈ g, {[x := a]}) ≡ gset_to_gmap a g.
+  Proof.
+    rewrite big_opMS.
+    rewrite -(big_opM_singletons (gset_to_gmap a g)).
+    rewrite /gset_to_gmap big_opM_fmap //.
+  Qed.
+
+  Lemma big_opM_fmap_singletons
+    {B: cmra} (m : gmap K A) (f: A -> B)
+    (LE: LeibnizEquiv B):
+    ([^ op map] k↦x ∈ m, f <$> {[k := x]}) = (f <$> m: gmap K B).
+  Proof.
+    intros. pattern m. apply map_ind.
+    { rewrite big_opM_empty fmap_empty. done. }
+    intros. 
+    rewrite insert_union_singleton_l.
+    apply leibniz_equiv.
+    rewrite big_opM_union.
+    2: { by apply map_disjoint_singleton_l_2. }
+    rewrite H1. rewrite big_opM_singleton.
+    rewrite map_fmap_union. rewrite !map_fmap_singleton /=.
+    apply leibniz_equiv_iff. apply gmap_disj_op_union.
+    apply map_disjoint_singleton_l_2. rewrite lookup_fmap H0. done.
+  Qed.
+
+  Lemma big_opM_insert_delete':
+  ∀ {M : ofe} {o : M → M → M} {Monoid0 : Monoid o}
+    {B : Type} 
+    (f : K → B → M) (m : gmap K B) (i : K) (x : B),
+    m !! i = Some x ->
+    ([^ o map] k↦y ∈ m, f k y)
+    ≡ o (f i x) ([^ o map] k↦y ∈ delete i m, f k y).
+  Proof.
+    intros. rewrite -big_opM_insert_delete.
+    symmetry. eapply big_opM_insert_override; eauto.
+  Qed.
+  
+End bigop_utils.
+
+
+
+Lemma fmap_flat_map {A B C: Type} (f : A → list B) (g: B -> C) (l : list A):
+  g <$> (flat_map f l) = flat_map ((fmap g) ∘ f) l.
+Proof.
+  induction l; [done| ].
+  simpl. rewrite fmap_app. congruence.
+Qed.
+
+Lemma concat_NoDup {A: Type} (ll : list (list A)):
+  (forall i l, ll !! i = Some l -> NoDup l) ->
+  (forall i j li lj, i ≠ j -> ll !! i = Some li -> ll !! j = Some lj -> li ## lj) ->
+  NoDup (concat ll).
+Proof.
+  induction ll.
+  { constructor. }
+  intros. simpl. apply NoDup_app. repeat split.
+  { apply (H 0). done. }
+  2: { apply IHll.
+       - intros. apply (H (S i)). done.
+       - intros. apply (H0 (S i) (S j)); auto. }
+  intros. intros [lx [INlx INx]]%elem_of_list_In%in_concat.
+  apply elem_of_list_In, elem_of_list_lookup_1 in INlx as [ix IX].
+  eapply (H0 0 (S ix)).
+  - lia.
+  - simpl. reflexivity.
+  - simpl. apply IX.
+  - eauto.
+  - by apply elem_of_list_In.
+Qed.
+
+
+Ltac add_case C name :=
+  match goal with
+  | |- ?G => assert (C -> G) as name
+  end.
+
+
+Section Arithmetic.
+
+  Lemma even_succ_negb n: Nat.even (S n) = negb $ Nat.even n.
+  Proof. by rewrite Nat.even_succ Nat.negb_even. Qed.
+
+  Lemma odd_succ_negb n: Nat.odd (S n) = negb $ Nat.odd n.
+  Proof. by rewrite Nat.odd_succ Nat.negb_odd. Qed.
+
+  Lemma even_plus1_negb n: Nat.even (n + 1) = negb $ Nat.even n.
+  Proof. by rewrite Nat.add_1_r even_succ_negb. Qed. 
+
+  Lemma odd_plus1_negb n: Nat.odd (n + 1) = negb $ Nat.odd n.
+  Proof. by rewrite Nat.add_1_r odd_succ_negb. Qed.
+
+  Lemma even_odd_False n : Nat.even n → Nat.odd n → False.
+  Proof.
+    intros Heven Hodd. rewrite -Nat.negb_odd in Heven.
+    apply Is_true_true_1 in Heven.
+    apply Is_true_true_1 in Hodd.
+    by rewrite Hodd in Heven.
+  Qed.
+  
+  Lemma even_not_odd n : Nat.even n → ¬ Nat.odd n.
+  Proof. intros Heven Hodd. by eapply even_odd_False. Qed.
+  
+  Lemma odd_not_even n : Nat.odd n → ¬ Nat.even n.
+  Proof. intros Heven Hodd. by eapply even_odd_False. Qed.
+  
+  Lemma even_or_odd n: Nat.even n \/ Nat.odd n.
+  Proof. 
+    destruct (decide (Nat.even n)) as [| O]; auto.
+    apply negb_prop_intro in O. rewrite Nat.negb_even in O. tauto.
+  Qed.
+
+End Arithmetic.
diff --git a/fairness/utils_logic.v b/fairness/utils_logic.v
new file mode 100644
index 0000000..9ab3ae7
--- /dev/null
+++ b/fairness/utils_logic.v
@@ -0,0 +1,180 @@
+From Stdlib Require Import ClassicalFacts.
+From Stdlib Require Import Lia.
+From stdpp Require Import base option.
+
+
+Section LogicHelpers.
+
+  Lemma ex2_comm {A B: Type} (P: A -> B -> Prop):
+    (exists (a: A) (b: B), P a b) <-> (exists (b: B) (a: A), P a b).
+  Proof. 
+    split; intros (?&?&?); eauto. 
+  Qed. 
+
+  Lemma iff_and_impl_helper {A B: Prop} (AB: A -> B):
+    A /\ B <-> A.
+  Proof. tauto. Qed.     
+
+  Lemma iff_True_helper {A: Prop}:
+    (A <-> True) <-> A.
+  Proof. tauto. Qed.     
+
+  Lemma iff_False_helper {A: Prop}:
+    (A <-> False) <-> not A.
+  Proof. tauto. Qed.
+
+  Lemma ex_and_comm {T: Type} (A: Prop) (B: T -> Prop):
+    (exists t, A /\ B t) <-> A /\ exists t, B t.
+  Proof. split; intros (?&?&?); eauto. Qed.
+
+  Lemma ex_prod {A B: Type} (P: A * B -> Prop):
+    (exists ab, P ab) <-> (exists a b, P (a, b)).
+  Proof.
+    split.
+    - intros [[??] ?]. eauto.
+    - intros (?&?&?). eauto.
+  Qed. 
+
+  Lemma ex_prod' {A B: Type} (P: A -> B -> Prop):
+    (exists a b, P a b) <-> (exists ab, P (fst ab) (snd ab)).
+  Proof.
+    split.
+    - intros (?&?&?). eexists (_, _). eauto.
+    - intros [[??] ?]. eauto.
+  Qed.
+
+  Lemma ex_proper3 {A B C: Prop} (P Q: A -> B -> C -> Prop)
+    (EQUIV: forall a b c, P a b c <-> Q a b c):
+    (exists a b c, P a b c) <-> (exists a b c, Q a b c).
+  Proof.
+    split; intros (?&?&?&?); do 3 eexists; apply EQUIV; eauto. 
+  Qed. 
+
+  Lemma ex_det_iff {A: Type} (P: A -> Prop) a
+    (DET: forall a', P a' -> a' = a):
+    (exists a', P a') <-> P a.
+  Proof. 
+    split; [| eauto].
+    intros [? ?]. erewrite <- DET; eauto.
+  Qed. 
+
+  Lemma iff_and_pre {A B C: Prop}
+    (BC: A -> (B <-> C)):
+    A /\ B <-> A /\ C.
+  Proof using. tauto. Qed.
+
+  Lemma curry_uncurry_prop {A B C: Prop}:
+    (A -> B -> C) <-> (A /\ B -> C).
+  Proof. tauto. Qed. 
+
+  Lemma forall_eq_gen {A: Type} (P: A -> Prop):
+    forall a, P a <-> (forall a', a' = a -> P a').
+  Proof.
+    split; eauto.
+    intros ?? ->. eauto.
+  Qed.
+
+  Lemma exist_impl_forall {A: Type} {P: A -> Prop} {Q: Prop}:
+    ((exists x, P x) -> Q) <-> (forall x, P x -> Q).
+  Proof using.
+    split.
+    - intros PQ x Px. eauto.
+    - intros PQ [x Px]. eauto.
+  Qed. 
+
+  Lemma forall_prod_helper {A B: Type} (P: A -> B -> Prop):
+    (forall a b, P a b) <-> (forall ab: A * B, P (fst ab) (snd ab)).
+  Proof.
+    split; eauto. intros PP ??.
+    apply (PP (a, b)).
+  Qed.    
+  
+  Lemma impl_iff_intro {A B C: Prop}
+    (PRE: A -> B <-> C):
+    (A -> B) <-> (A -> C).
+  Proof using. tauto. Qed.
+
+End LogicHelpers.
+
+
+Lemma min_prop_dec_impl (P: nat -> Prop) (DEC: forall n, Decision (P n)):
+  forall n, P n -> {m | Minimal P m}.
+Proof.
+  intros n Pn.
+
+  assert (forall p, p <= n + 1 -> ({m | Minimal P m} + {forall k, k < p -> ¬ P k})) as MIN'.
+  2: { destruct (MIN' (n + 1)); eauto. edestruct n0; eauto. lia. }
+
+  induction p.
+  { intros. right. lia. }
+  intros. destruct IHp; [lia| auto| ].
+  rewrite PeanoNat.Nat.add_1_r in H. apply le_S_n in H. 
+  destruct (DEC p).
+  - left. exists p. split; auto. intros.
+    destruct (PeanoNat.Nat.le_decidable p k); auto.
+    destruct (n0 k); auto. lia.
+  - right. intros. destruct (PeanoNat.Nat.eq_decidable k p); [congruence| ].
+    apply n0. lia.
+Qed. 
+
+Lemma min_prop_dec (P: nat -> Prop) (DEC: forall n, Decision (P n)):
+  ClassicalFacts.Minimization_Property P.
+Proof using.
+  red. intros ? Pn.
+  edestruct (min_prop_dec_impl _ _ _ Pn). eauto.  
+Qed.
+
+Global Instance Minimal_proper: 
+  Proper (pointwise_relation nat iff ==> eq ==> iff) ClassicalFacts.Minimal.
+Proof using.
+  red. red. intros. red. intros. subst. red in H. 
+  split; intros [P MIN].
+  all: split; [| intros; apply MIN]; apply H; auto.
+Qed. 
+
+Definition Minimal_pos (P: BinNums.positive → Prop) (n : BinNums.positive) :=
+  P n ∧ (∀ k, P k → BinPos.Pos.le n k). 
+
+Lemma min_prop_dec_impl_pos (P: BinNums.positive -> Prop) (DEC: forall n, Decision (P n)):
+  ∀ n, P n → {m: BinNums.positive | Minimal_pos P m }.
+Proof.
+  intros n Pn.
+  epose proof (min_prop_dec_impl (P ∘ BinPos.Pos.of_nat) _ (BinPos.Pos.to_nat n)) as [m [Pm MINm]].
+  { red. rewrite Pnat.Pos2Nat.id. auto. }
+  exists (BinPos.Pos.of_nat m). split; auto.
+  intros.
+  specialize (MINm (BinPos.Pos.to_nat k) ltac:(red; rewrite Pnat.Pos2Nat.id; eauto)).
+  lia. 
+Qed.
+
+
+(* TODO: already exists somewhere? *)
+Lemma Decision_iff_impl (P Q: Prop) (PQ: P <-> Q) (DEC_P: Decision P):
+  Decision Q. 
+Proof using. 
+  destruct DEC_P; [left | right]; tauto. 
+Qed.  
+
+Instance ex_fin_dec {T: Type} (P: T -> Prop) (l: list T)
+  (DEC: forall a, Decision (P a))
+  (IN: forall a, P a -> In a l):
+  Decision (exists a, P a).
+Proof.
+  destruct (Exists_dec P l) as [EX|NEX].
+  { eauto. }
+  - left. apply List.Exists_exists in EX as (?&?&?). eauto.
+  - right. intros [a Pa]. apply NEX.
+    apply List.Exists_exists. eexists. split; eauto.
+Qed. 
+
+(** useful for rewriting in equivalences *)
+Lemma is_Some_Some_True {A: Type} (a: A):
+  is_Some (Some a) <-> True.
+Proof. done. Qed. 
+
+(** useful for rewriting in equivalences *)
+Lemma is_Some_None_False {A: Type}:
+  is_Some (None: option A) <-> False.
+Proof.
+  split; [| done]. by intros []. 
+Qed. 
diff --git a/fairness/utils_maps.v b/fairness/utils_maps.v
new file mode 100644
index 0000000..e2874bd
--- /dev/null
+++ b/fairness/utils_maps.v
@@ -0,0 +1,407 @@
+From stdpp Require Import base.
+From iris.proofmode Require Import tactics.
+From fairness Require Export utils_logic.
+From iris.algebra Require Import gmap gset agree.
+From trillium.prelude Require Import finitary.
+
+Section gmap.
+  Context `{!EqDecision K, !Countable K}.
+
+  Definition max_gmap (m: gmap K nat) : nat :=
+    map_fold (λ k v r, v `max` r) 0 m.
+
+  Lemma max_gmap_spec m:
+    map_Forall (λ _ v, v <= max_gmap m) m.
+  Proof.
+    induction m using map_ind; first done.
+    apply map_Forall_insert =>//. rewrite /max_gmap map_fold_insert //.
+    - split; first lia. intros ?? Hnotin. specialize (IHm _ _ Hnotin). simpl in IHm.
+      unfold max_gmap in IHm. lia.
+    - intros **. lia.
+  Qed.
+
+  Lemma gmap_disj_op_union:
+    ∀ {A : cmra} (m1 m2 : gmap K A),
+      map_disjoint m1 m2 -> m1 ⋅ m2 = m1 ∪ m2. 
+  Proof using. 
+    intros. apply map_eq. intros.
+    rewrite lookup_op lookup_union.
+    destruct (m1 !! i) eqn:L1, (m2 !! i) eqn:L2; try done.
+    eapply map_disjoint_spec in H; done.
+  Qed.
+
+  Lemma map_split {A: Type} (m: gmap K A) k:
+    m = from_option (singletonM k) ∅ (m !! k) ∪ delete k m.
+  Proof using.
+    apply map_eq. intros k'.
+    destruct (decide (k' = k)) as [->|?].
+    - destruct (m !! k) eqn:KTH.
+      + simpl. rewrite lookup_union_l'.
+        all: by rewrite lookup_singleton.
+      + simpl. rewrite lookup_union_r; [| done].
+        by rewrite lookup_delete.
+    - rewrite lookup_union_r.
+      2: { destruct (m !! k); [| set_solver]. 
+           by rewrite lookup_singleton_ne. } 
+      by rewrite lookup_delete_ne.
+  Qed.
+  
+  Lemma lookup_map_singleton {A: Type} (k: K) (a: A) k':
+    ({[ k := a ]}: gmap K A) !! k' = if (decide (k' = k)) then Some a else None.
+  Proof using.
+    destruct decide; subst.
+    - apply lookup_singleton.
+    - by apply lookup_singleton_ne.
+  Qed. 
+
+  Lemma map_fold_union
+    {V B: Type}
+    (m1 m2: gmap K V)
+    (f: K → V → B → B)
+    (b0: B)
+    (DISJ: map_disjoint m1 m2)
+    (ASSOC: forall a b c d e, f a b (f c d e) = f c d (f a b e))
+    :
+    map_fold f b0 (m1 ∪ m2) = map_fold f (map_fold f b0 m1) m2.
+  Proof using.
+    clear -DISJ ASSOC.
+    revert DISJ. pattern m2. apply map_ind; clear m2.
+    { rewrite map_union_empty. rewrite map_fold_empty. done. }
+    intros ??? NOI IH DISJ. rewrite map_union_comm; [| set_solver].
+    rewrite -insert_union_l. simpl.
+    rewrite map_fold_insert_L.
+    3: { rewrite lookup_union_r; [| done].
+         apply not_elem_of_dom. intros IN.
+         apply map_disjoint_dom in DISJ.
+         set_solver. }
+    2: { done. }
+    apply map_disjoint_dom in DISJ. specialize (IH ltac:(apply map_disjoint_dom; set_solver)).
+    rewrite map_union_comm in IH.
+    2: { apply map_disjoint_dom. set_solver. }
+    rewrite IH.
+    rewrite map_fold_insert_L; done.
+  Qed.
+    
+  Lemma gmap_filter_dom_id {A: Type} (m: gmap K A):
+    filter (fun '(k, _) => k ∈ dom m) m = m.
+  Proof.
+    rewrite map_filter_id; [done| ].
+    intros. by eapply elem_of_dom_2. 
+  Qed. 
+
+  Lemma gmap_empty_subseteq_equiv {A: Type} (m: gmap K A):
+    m ⊆ ∅ <-> m = ∅. 
+  Proof.
+    clear.
+    split; [| set_solver].
+    intros E. destruct (map_eq_dec_empty m); try set_solver.
+    apply map_choose in n as (?&?&?).
+    eapply lookup_weaken in E; set_solver. 
+  Qed. 
+  
+  Lemma gmap_filter_disj_id {A: Type} (m1 m2: gmap K A)
+    (DISJ: m1 ##ₘ m2):
+    m1 = filter (λ '(k, _), k ∈ dom m1) (m1 ∪ m2).
+  Proof.
+    rewrite map_filter_union; auto.
+    rewrite map_union_comm; [| by apply map_disjoint_filter]. 
+    rewrite gmap_filter_dom_id.
+    symmetry. apply map_subseteq_union. etransitivity; [| apply map_empty_subseteq].
+    apply gmap_empty_subseteq_equiv. 
+    eapply map_filter_empty_iff. apply map_Forall_lookup_2.
+    intros. intros [? ?]%elem_of_dom. eapply map_disjoint_spec; eauto.
+  Qed. 
+
+End gmap.
+
+Lemma map_img_insert_L :
+  ∀ {K : Type} {M : Type → Type} {H : FMap M} {H0 : ∀ A : Type, Lookup K A (M A)} 
+    {H1 : ∀ A : Type, Empty (M A)} {H2 : ∀ A : Type, PartialAlter K A (M A)} 
+    {H3 : OMap M} {H4 : Merge M}
+    {H5 : ∀ A : Type, MapFold K A (M A)}
+    {EqDecision0 : EqDecision K}
+  ,
+    FinMap K M
+    → ∀ {A SA : Type} {H7 : ElemOf A SA} {H8 : Empty SA} 
+        {H9 : Singleton A SA} {H10 : Union SA} {H11 : Intersection SA} 
+        {H12 : Difference SA}
+        {LE: LeibnizEquiv SA}
+    ,
+      Set_ A SA
+      → ∀ (m : M A) (i : K) (x : A),
+        map_img (<[i:=x]> m) = ({[x]}: SA) ∪ map_img (delete i m).
+Proof.
+  intros. apply leibniz_equiv. apply map_img_insert. 
+Qed.  
+
+
+Notation "f ⇂ R" := (filter (λ '(k,v), k ∈ R) f) (at level 30).
+
+Lemma dom_domain_restrict `{Countable X} {A} (f: gmap X A) (R: gset X):
+  R ⊆ dom f ->
+  dom  (f ⇂ R) = R.
+Proof.
+  intros ?. apply dom_filter_L.
+  intros i; split; [|set_solver].
+  intros Hin. assert (Hin': i ∈ dom f) by set_solver.
+  apply elem_of_dom in Hin' as [??]. set_solver.
+Qed.
+
+Lemma dom_filter_sub {K V: Type} `{Countable K} (m: gmap K V)
+  (ks: gset K):
+  dom (filter (λ '(k, _), k ∈ ks) m) ⊆ ks.
+Proof.
+  apply elem_of_subseteq.
+  intros ? IN. rewrite elem_of_dom in IN. destruct IN as [? IN].
+  apply map_lookup_filter_Some in IN. apply IN.
+Qed. 
+
+Lemma dom_filter_comm {K A: Type} `{Countable K}
+  (P: K -> Prop) `{∀ x : K, Decision (P x)}:
+  forall (m: gmap K A), dom (filter (fun '(k, _) => P k) m) = filter P (dom m).
+Proof.
+  intros. apply leibniz_equiv. apply dom_filter. intros.
+  rewrite elem_of_filter elem_of_dom.
+  rewrite /is_Some. split; [intros [?[??]] | intros [? [??]]]; eauto.
+Qed.
+
+
+Lemma dom_domain_restrict_union_l `{Countable X} {A} (f: gmap X A) R1 R2:
+  R1 ∪ R2 ⊆ dom f ->
+  dom (f ⇂ R1) = R1.
+Proof.
+  intros ?. apply dom_domain_restrict. set_solver.
+Qed.
+Lemma dom_domain_restrict_union_r `{Countable X} {A} (f: gmap X A) R1 R2:
+  R1 ∪ R2 ⊆ dom f ->
+  dom (f ⇂ R2) = R2.
+Proof.
+  intros ?. apply dom_domain_restrict. set_solver.
+Qed.
+
+
+Lemma gmap_filter_or `{Countable K} {A: Type} (P1 P2: K * A -> Prop)
+  `{forall x, Decision (P1 x)} `{forall x, Decision (P2 x)}
+  (m: gmap K A):
+  filter (fun x => P1 x \/ P2 x) m = filter P1 m ∪ filter P2 m.
+Proof using.
+  clear.
+  apply map_eq. intros k.
+  destruct (m !! k) eqn:KTH.
+  2: { etrans; [| symmetry].
+       { eapply map_lookup_filter_None. tauto. }
+       apply lookup_union_None_2; eapply map_lookup_filter_None; tauto. }
+  destruct (decide (P1 (k, a))).
+  { erewrite map_lookup_filter_Some_2; eauto.
+    erewrite lookup_union_Some_l; eauto. eapply map_lookup_filter_Some; eauto. }
+  erewrite lookup_union_r; eauto.
+  2: { eapply map_lookup_filter_None. set_solver. }
+  destruct (decide (P2 (k, a))).
+  { erewrite map_lookup_filter_Some_2; eauto.      
+    symmetry. apply map_lookup_filter_Some_2; eauto. }
+  etrans; [| symmetry]; eapply map_lookup_filter_None; set_solver.
+Qed.
+
+Section MapsInverseMatch.
+  Context `{Countable K, Countable V, EqDecision K}.
+
+  Definition maps_inverse_match (m: gmap K V) (m': gmap V (gset K)) :=
+    ∀ (k: K) (v: V), m !! k = Some v <-> ∃ (ks: gset K), m' !! v = Some ks ∧ k ∈ ks.
+
+  Lemma no_locale_empty M M' ρ ζ:
+    maps_inverse_match M M' ->
+    M' !! ζ = Some ∅ ->
+    M !! ρ ≠ Some ζ.
+  Proof.
+    intros Hinv Hem contra.
+    destruct (Hinv ρ ζ) as [Hc _]. destruct (Hc contra) as (?&?&?).
+    by simplify_eq.
+  Qed.
+
+  Lemma maps_inverse_bij M M' ρ X1 X2 ζ ζ':
+    maps_inverse_match M M' ->
+    M' !! ζ = Some X1 -> ρ ∈ X1 ->
+    M' !! ζ' = Some X2 -> ρ ∈ X2 ->
+    ζ = ζ'.
+  Proof.    intros Hinv Hζ Hρ Hζ' Hρ'.
+    assert (M !! ρ = Some ζ); first by apply Hinv; eexists; done.
+    assert (M !! ρ = Some ζ'); first by apply Hinv; eexists; done.
+    congruence.
+  Qed.
+
+  Lemma maps_inverse_match_exact (v: V) (S: gset K):
+    maps_inverse_match (gset_to_gmap v S) {[v := S]}.
+  Proof.
+    red. intros. rewrite lookup_gset_to_gmap_Some. split.
+    - intros [? ->]. eexists. split; eauto. apply lookup_singleton.
+    - intros [? [[? ->]%lookup_singleton_Some ?]]. done.
+  Qed.    
+  
+  Lemma maps_inverse_match_uniq1 (m1 m2: gmap K V) (m': gmap V (gset K))
+    (M1: maps_inverse_match m1 m') (M2: maps_inverse_match m2 m'):
+    m1 = m2.
+  Proof.
+    red in M1, M2. apply map_eq. intros.
+    destruct (m1 !! i) eqn:L1.
+    - pose proof (proj1 (M1 _ _) L1) as EQ.
+      pose proof (proj2 (M2 _ _) EQ).
+      congruence.
+    - destruct (m2 !! i) eqn:L2; [| done].
+      pose proof (proj1 (M2 _ _) L2) as EQ.
+      pose proof (proj2 (M1 _ _) EQ).
+      congruence.
+  Qed.
+
+  Lemma maps_inverse_match_subseteq (m1 m2: gmap K V) (m1' m2': gmap V (gset K))
+    (M1: maps_inverse_match m1 m1') (M2: maps_inverse_match m2 m2')
+    (SUB: dom m1' ⊆ dom m2')
+    (INCL: forall v S1 S2, m1' !! v = Some S1 -> m2' !! v = Some S2 -> S1 ⊆ S2):
+    m1 ⊆ m2.
+  Proof.
+    red in M1, M2. apply map_subseteq_spec. intros.
+    specialize (proj1 (M1 _ _) H1) as [? [L1 ?]]. 
+    apply M2.
+    specialize (SUB x (elem_of_dom_2 _ _ _ L1)).
+    apply elem_of_dom in SUB as [? ?].
+    eexists. split; eauto. set_solver.
+  Qed. 
+
+  Lemma mim_in_1 (m: gmap K V) (m': gmap V (gset K)) k v
+    (MIM: maps_inverse_match m m')
+    (DOM: m !! k = Some v):
+      v ∈ dom m'.
+  Proof.
+    red in MIM.
+    pose proof (proj1 (MIM _ _) DOM) as (?&?&?).
+    apply elem_of_dom. set_solver.
+  Qed. 
+
+  Lemma mim_in_2 (m: gmap K V) (m': gmap V (gset K)) k v
+    (MIM: maps_inverse_match m m')
+    (IN: k ∈ default ∅ (m' !! v)):
+      k ∈ dom m.
+  Proof.
+    red in MIM.
+    destruct (m' !! v) eqn:TM.
+    2: { done. }
+    simpl in IN.
+    specialize (MIM k v). apply proj2 in MIM.
+    eapply elem_of_dom. eexists.
+    apply MIM. eauto. 
+  Qed. 
+
+  Lemma mim_lookup_helper
+    (tm: gmap V (gset K)) (m: gmap K V)
+    R ζ
+    (MIM: maps_inverse_match m tm)
+    (NE: R ≠ ∅)
+    (DOM: ∀ ρ, m !! ρ = Some ζ ↔ ρ ∈ R):
+    tm !! ζ = Some R.
+  Proof. 
+    apply finitary.set_choose_L' in NE as [k INR].
+    pose proof (proj2 (DOM k) INR) as MAP.
+    red in MIM. specialize MIM with (v := ζ). 
+    pose proof (proj1 (MIM _ ) MAP) as (R' & TM' & IN').
+    rewrite TM'. f_equal.
+    apply set_eq. clear dependent k. intros k.
+    rewrite <- DOM. rewrite TM' in MIM. split.
+    - intros IN'. apply MIM. eauto.
+    - intros ?%MIM. set_solver.
+  Qed. 
+
+  Lemma mim_neg m tm
+    (MIM: maps_inverse_match m tm):
+    ∀ (k: K), m !! k = None <-> forall g, k ∉ default ∅ (tm !! g).
+  Proof. 
+    intros. red in MIM. specialize (MIM k). split.
+    - intros MAP. intros g IN.
+      destruct (tm !! g) eqn:TM; set_solver.
+    - intros NIN. destruct (m !! k) eqn:MAP; [| done].
+      pose proof (proj1 (MIM v) eq_refl) as (?&?&?).
+      specialize (NIN v). rewrite H1 in NIN. set_solver.
+  Qed. 
+
+End MapsInverseMatch.
+
+Section fin_map_dom.
+Context `{FinMapDom K M D}.
+Lemma dom_empty_iff {A} (m : M A) : dom m ≡ ∅ ↔ m = ∅.
+Proof.
+  split; [|intros ->; by rewrite dom_empty].
+  intros E. apply map_empty. intros. apply not_elem_of_dom.
+  rewrite E. set_solver.
+Qed.
+
+Section leibniz.
+  Context `{!LeibnizEquiv D}.
+  Lemma dom_empty_iff_L {A} (m : M A) : dom m = ∅ ↔ m = ∅.
+  Proof. unfold_leibniz. apply dom_empty_iff. Qed.
+End leibniz.
+End fin_map_dom.
+
+Section map_imap.
+  Context `{Countable K}.
+  Lemma map_imap_dom_inclusion {A B} (f : K → A → option B) (m : gmap K A) :
+    dom (map_imap f m) ⊆ dom m.
+  Proof.
+    intros i [k Hk]%elem_of_dom. rewrite map_lookup_imap in Hk.
+    destruct (m !! i) eqn:?; last done.
+    rewrite elem_of_dom. by eexists.
+  Qed.
+  Lemma map_imap_dom_eq {A B} (f : K → A → option B) (m : gmap K A) :
+    (forall k a, k ∈ dom m -> is_Some (f k a)) ->
+    dom (map_imap f m) = dom m.
+  Proof.
+    rewrite -leibniz_equiv_iff. intros HisSome i. split.
+    - intros [x Hx]%elem_of_dom. rewrite map_lookup_imap in Hx.
+      apply elem_of_dom. destruct (m !! i) eqn:Heq; eauto.
+      by simpl in Hx.
+    - intros [x Hx]%elem_of_dom.
+      rewrite elem_of_dom map_lookup_imap Hx /=. apply HisSome, elem_of_dom. eauto.
+  Qed.
+End map_imap.
+
+
+Section TmapDisj.
+  Context `{Countable K} `{Countable V}. 
+
+  Definition tmap_disj (tm: gmap K (gset V)) :=
+    forall (k1 k2: K) (S1 S2: gset V) (NEQ: k1 ≠ k2),
+      tm !! k1 = Some S1 -> tm !! k2 = Some S2 -> S1 ## S2.
+
+  Global Instance tmap_disj_dec tm: Decision (tmap_disj tm).
+  Proof.
+    set pairs := let d := elements (dom tm) in
+                 k1 ← d; k2 ← d;
+                 if (decide (k1 = k2)) then [] else [(k1, k2)]. 
+    set alt := Forall (fun '(k1, k2) => (default ∅ (tm !! k1)) ## (default ∅ (tm !! k2))) pairs.
+    apply Decision_iff_impl with (P := alt); [| solve_decision].
+    rewrite /alt. rewrite Forall_forall. 
+    rewrite /pairs.
+    repeat setoid_rewrite elem_of_list_bind.
+    repeat setoid_rewrite elem_of_elements.
+    rewrite /tmap_disj.
+    repeat setoid_rewrite elem_of_dom.
+    rewrite forall_prod_helper. apply forall_proper. intros [k1 k2]. simpl.
+    erewrite ex_det_iff with (a := k1).
+    2: { intros ?. erewrite ex_det_iff with (a := k2).
+         2: { intros ?. destruct decide; set_solver. }
+         destruct decide; set_solver. }
+    erewrite ex_det_iff with (a := k2).
+    2: { intros ?. destruct decide; set_solver. }
+    destruct decide; [set_solver| ].
+    destruct (tm !! k1), (tm !! k2); set_solver.
+  Qed. 
+
+End TmapDisj.
+
+
+Lemma map_nat_agree_valid {A: ofe} (m: gmap nat A):
+  ✓ ((to_agree <$> m): gmapUR nat (agreeR A)).
+Proof using.
+  red. intros k.
+  destruct lookup eqn:LL; [| done].
+  apply lookup_fmap_Some in LL. 
+  destruct LL as (a&<-&?). 
+  done.
+Qed.
diff --git a/fairness/utils_relations.v b/fairness/utils_relations.v
new file mode 100644
index 0000000..78ca523
--- /dev/null
+++ b/fairness/utils_relations.v
@@ -0,0 +1,159 @@
+From Stdlib Require Import Relation_Operators Operators_Properties.
+From stdpp Require Import relations.
+From iris.proofmode Require Import tactics.
+
+
+Section RelationsUtils.
+  Context {A: Type}.
+
+  (* TODO: find existing definition *)
+  Definition rel_compose (R1 R2 : relation A): relation A :=
+    fun x y => exists z, R1 x z /\ R2 z y.
+  
+  Global Instance rel_subseteq: SubsetEq (relation A) :=
+    fun R1 R2 => forall x y, R1 x y -> R2 x y. 
+
+  Global Instance rel_compose_mono:
+    Proper (subseteq ==> subseteq ==> subseteq) rel_compose.
+  Proof.
+    red. intros ??????. rewrite /rel_compose.
+    red. intros ?? (?&?&?). eexists. eauto.
+  Qed.
+  
+  Lemma nsteps_0 (R: relation A) x y: nsteps R 0 x y <-> x = y.
+  Proof.
+    split.
+    - intros STEP. by inversion STEP.
+    - intros ->. constructor.
+  Qed. 
+  
+  Lemma nsteps_1 (R: relation A) x y: nsteps R 1 x y <-> R x y.
+  Proof.
+    split.
+    - intros STEP. inversion STEP; subst. inversion H1. by subst. 
+    - intros. econstructor; eauto. constructor. 
+  Qed. 
+  
+  Lemma rel_compose_nsteps_next' (r: relation A) n:
+    forall x y,
+      rel_compose r (relations.nsteps r n) x y <->
+        relations.nsteps r (S n) x y.
+  Proof using.
+    intros. split.
+    - intros (?&?&?). econstructor; eauto.
+    - intros STEP. inversion STEP. subst. eexists. eauto.
+  Qed. 
+
+  Lemma rel_compose_assoc (R1 R2 R3: relation A) x y:
+    rel_compose (rel_compose R1 R2) R3 x y <-> rel_compose R1 (rel_compose R2 R3) x y.
+  Proof.
+    intros. rewrite /rel_compose. set_solver.
+  Qed. 
+
+  Lemma rel_compose_nsteps_plus (r: relation A) n m:
+    forall x y,
+      rel_compose (relations.nsteps r n) (relations.nsteps r m) x y <->
+        relations.nsteps r (n + m) x y.
+  Proof using.
+    intros. generalize dependent y. generalize dependent x. induction n; intros.
+    { rewrite /rel_compose. simpl. setoid_rewrite nsteps_0. set_solver. }    
+    rewrite Nat.add_succ_l -rel_compose_nsteps_next'. 
+    rewrite /rel_compose. setoid_rewrite <- rel_compose_nsteps_next'.
+    setoid_rewrite rel_compose_assoc. rewrite /rel_compose.
+    by setoid_rewrite IHn. 
+  Qed. 
+
+  Lemma rel_compose_nsteps_next (r: relation A) n:
+    forall x y,
+      rel_compose (relations.nsteps r n) r x y <->
+        relations.nsteps r (S n) x y.
+  Proof using.
+    intros. rewrite /rel_compose.
+    setoid_rewrite <- (nsteps_1 r). setoid_rewrite rel_compose_nsteps_plus.
+    f_equiv. lia. 
+  Qed. 
+  
+  Global Instance rel_subseteq_po: PreOrder rel_subseteq.
+  Proof.
+    rewrite /rel_subseteq. split; eauto.
+  Qed.
+
+  Lemma strict_not_both (R: relation A) x y:
+    strict R x y -> strict R y x -> False.
+  Proof using.      
+    clear. intros [??] [??]. done.
+  Qed.
+
+  Global Instance nsteps_mono n:
+    Proper (subseteq ==> subseteq) (fun R => nsteps R n).
+  Proof.
+    red. induction n.
+    { intros ????? ?%nsteps_0. by apply nsteps_0. }
+    intros ????? (? & STEPS & STEP)%rel_compose_nsteps_next.
+    eapply IHn in STEPS; eauto.
+    eapply rel_compose_nsteps_next. eexists. split; eauto. 
+  Qed.
+  
+  Lemma clos_refl_nsteps (R: relation A) x y
+    (CR: clos_refl _ R x y):
+    exists n, nsteps R n x y.
+  Proof using.
+    inversion CR; subst.
+    - exists 1. by apply nsteps_1.
+    - exists 0. by apply nsteps_0.
+  Qed.                          
+    
+  Global Instance nsteps_impl:
+    Proper ((eq ==> eq ==> impl) ==> eq ==> (eq ==> eq ==> impl)) (@relations.nsteps A).
+  Proof using.
+    red. intros ?????????????. subst. red in H.
+    generalize dependent y2. induction y0.
+    { intros ?. by rewrite !nsteps_0. }
+    intros ?. rewrite -!rel_compose_nsteps_next.
+    intros (?&STEPS&STEP). apply IHy0 in STEPS.
+    eexists. split; eauto. eapply H; eauto.
+  Qed. 
+
+  Global Instance clos_trans_1n_proper_impl (R: relation A)
+    (E: relation A)
+    {REFL_E: Reflexive E}
+    (PR: Proper (E ==> E ==> impl) R):
+    Proper (E ==> E ==> impl) (clos_trans_1n _ R).
+  Proof using.
+    red. intros x1 x2 Ex y1 y2 Ey. intros TR.
+    generalize dependent x2. generalize dependent y2.
+    induction TR.
+    + intros. econstructor. eapply PR; [..| apply H]; done.
+    + intros y2 Ez x2 Ex.
+      rename x into x1.
+      rename y2 into z2. rename z into z1.
+      rename y into y1.
+      eapply PR in H; eauto.     
+      specialize (IHTR _ Ez).
+      specialize (IHTR _ ltac:(reflexivity)).
+      eapply Relation_Operators.t1n_trans; eauto.
+  Qed.
+
+  Global Instance clos_trans_1n_proper_iff (R: relation A)
+    (E: relation A)
+    {SYM_E: Symmetric E}
+    {REFL_E: Reflexive E}
+    (PR: Proper (E ==> E ==> iff) R):
+    Proper (E ==> E ==> iff) (clos_trans_1n _ R).
+  Proof using.
+    red.
+    assert (Proper (E ==> E ==> impl) R).
+    { intros ???????. symmetry in H, H0. 
+      eapply PR; eauto. }
+    intros x1 x2 Ex y1 y2 Ey. split; intros. 
+    - eapply clos_trans_1n_proper_impl; eauto. 
+    - symmetry in Ex, Ey. eapply clos_trans_1n_proper_impl; eauto.
+  Qed. 
+
+  Lemma clos_trans_tn1_t1n_iff (R : relation A) (x y : A):
+    clos_trans_n1 A R x y ↔ clos_trans_1n A R x y.
+  Proof using.
+    by rewrite -clos_trans_t1n_iff clos_trans_tn1_iff.
+  Qed.
+  
+End RelationsUtils.
diff --git a/fairness/utils_sets.v b/fairness/utils_sets.v
new file mode 100644
index 0000000..c1dabbb
--- /dev/null
+++ b/fairness/utils_sets.v
@@ -0,0 +1,371 @@
+From stdpp Require Import base.
+From iris.proofmode Require Import tactics.
+From fairness Require Export utils_logic.
+From iris.algebra Require Import gset.
+
+Section SetMapProperties.
+  
+  Lemma set_map_compose_gset {A1 A2 A3: Type}
+    `{EqDecision A1} `{EqDecision A2} `{EqDecision A3}
+    `{Countable A1} `{Countable A2} `{Countable A3}
+    (f: A2 -> A3) (g: A1 -> A2) (m: gset A1):
+    set_map (f ∘ g) m (D:=gset _) = set_map f (set_map g m (D:= gset _)).
+  Proof using.
+    set_solver. 
+  Qed. 
+  
+  Lemma elem_of_map_inj_gset {A B} 
+    `{EqDecision A} `{Countable A}
+    `{EqDecision B} `{Countable B}
+    (f: A -> B) (m: gset A) (a: A) (INJ: Inj eq eq f):
+    a ∈ m <-> f a ∈ set_map f m (D := gset _).
+  Proof using.
+    split; [apply elem_of_map_2| ].
+    intros IN. apply elem_of_map_1 in IN as (a' & EQ & IN).
+    apply INJ in EQ. congruence. 
+  Qed.
+    
+End SetMapProperties.
+
+
+
+Section Powerset.
+  Context {K: Type}.
+  Context `{Countable K}. 
+  
+  (** it's easier to perform recursion on lists *)
+
+  Fixpoint powerlist (l: list K): gset (gset K) :=
+    match l with
+    | [] => {[ ∅ ]}
+    | k :: l' => let p' := powerlist l' in
+                 p' ∪ (set_map (fun s => {[ k ]} ∪ s) p')
+    end. 
+  
+  Definition powerset (s: gset K): gset (gset K) :=
+    powerlist (elements s).
+    
+  Lemma powerlist_nil l:
+    ∅ ∈ powerlist l.
+  Proof. induction l; set_solver. Qed.
+
+  Instance powerlist_perm_Proper:
+    Proper (Permutation ==> eq) powerlist.
+  Proof.
+    induction 1; csimpl; auto; cycle -1.
+    1, 2: congruence. 
+    rewrite -!union_assoc_L. f_equal. 
+    rewrite !set_map_union_L.
+    rewrite !union_assoc_L. f_equal.
+    { set_solver. }
+    rewrite -!set_map_compose_gset. apply leibniz_equiv.
+    f_equiv. red. simpl. set_solver.
+  Qed.
+
+  Lemma powerset_spec s:
+    forall e, e ⊆ s <-> e ∈ powerset s. 
+  Proof. 
+    intros. rewrite /powerset.
+    revert e. pattern s. apply set_ind.
+    { intros ?? EQUIV. apply leibniz_equiv_iff in EQUIV. by rewrite EQUIV. }
+    { rewrite elements_empty. simpl.
+      setoid_rewrite elem_of_singleton.
+      intros. set_solver. }
+    clear s. intros k s NIN IND e.
+    rewrite elements_disj_union; [| set_solver].
+    rewrite elements_singleton. simpl.
+    rewrite !elem_of_union elem_of_map.
+    repeat setoid_rewrite <- IND.
+    erewrite ex_det_iff with (a := e ∖ {[ k ]}).
+    2: { set_solver. }
+    destruct (decide (k ∈ e)); set_solver. 
+  Qed.              
+          
+End Powerset.
+
+
+Lemma set_filter_equiv:
+  ∀ {A C : Type} {H : ElemOf A C} {H0 : Empty C} {H1 : Singleton A C} 
+    {H2 : Union C} {H3 : Intersection C} {H4 : Difference C} 
+    {H5 : Elements A C} {EqDecision0 : EqDecision A}
+    {LL: LeibnizEquiv C}
+    {FS: FinSet A C}
+    (P1 P2 : A → Prop)
+    (DEC1: ∀ x : A, Decision (P1 x)) (DEC2: ∀ x : A, Decision (P2 x))
+    (P_EQ: forall x, P1 x <-> P2 x)
+    (c1 c2: C)
+    (EQUIV: c1 ≡ c2),
+    filter P1 c1 = filter P2 c2.
+Proof. set_solver. Qed.
+
+Lemma set_filter_and:
+  ∀ {A C : Type} {H : ElemOf A C} {H0 : Empty C} {H1 : Singleton A C} 
+    {H2 : Union C} {H3 : Intersection C} {H4 : Difference C} 
+    {H5 : Elements A C} {EqDecision0 : EqDecision A}
+    {LL: LeibnizEquiv C}
+    {FS: FinSet A C}
+    (P1 P2 : A → Prop)
+    (DEC1: ∀ x : A, Decision (P1 x)) (DEC2: ∀ x : A, Decision (P2 x))
+    (c: C),
+    filter P1 (filter P2 c) = filter (fun x => P1 x /\ P2 x) c.
+Proof. set_solver. Qed. 
+
+Lemma set_filter_comm:
+  ∀ {A C : Type} {H : ElemOf A C} {H0 : Empty C} {H1 : Singleton A C} 
+    {H2 : Union C} {H3 : Intersection C} {H4 : Difference C} 
+    {H5 : Elements A C} {EqDecision0 : EqDecision A}
+    {LL: LeibnizEquiv C}
+    {FS: FinSet A C}
+    (P1 P2 : A → Prop)
+    (DEC1: ∀ x : A, Decision (P1 x)) (DEC2: ∀ x : A, Decision (P2 x))
+    (c: C),
+    filter P1 (filter P2 c) = filter P2 (filter P1 c). 
+Proof. set_solver. Qed. 
+
+Lemma filter_singleton_if:
+  ∀ {A C : Type} {H : ElemOf A C} {H0 : Empty C} {H1 : Singleton A C} 
+    {H2 : Union C} {H3 : Intersection C} {H4 : Difference C} 
+    {H5 : Elements A C} {EqDecision0 : EqDecision A},
+    FinSet A C
+    → ∀ (P : A → Prop) {H7 : ∀ x : A, Decision (P x)} (x : A),
+        filter P ({[x]} : C) ≡ if decide (P x) then {[x]} else ∅.
+Proof. intros. destruct decide; set_solver. Qed. 
+
+Lemma elements_list_to_set_disj `{Countable A} (l: list A):
+  elements $ (list_to_set_disj l: gmultiset A) ≡ₚ l.
+Proof using.
+  clear. induction l.
+  { done. }
+  simpl. rewrite gmultiset_elements_disj_union.
+  simpl. rewrite gmultiset_elements_singleton.
+  rewrite IHl. done.
+Qed. 
+
+Lemma gset_filter_subseteq_mono_strong `{Countable A} (P Q: A -> Prop)
+  `{∀ x, Decision (P x)} `{∀ x, Decision (Q x)}
+  (g: gset A)
+  (IMPL: ∀ x, x ∈ g -> P x -> Q x):
+  filter P g ⊆ filter Q g.
+Proof using. clear -IMPL. set_solver. Qed. 
+
+Lemma gset_filter_True `{Countable K} (g: gset K)
+  (P: K -> Prop)
+  `{∀ x, Decision (P x)}
+  (TRUE: forall k, k ∈ g -> P k):
+  filter P g = g.
+Proof using. clear -TRUE. set_solver. Qed. 
+
+Lemma GSet_inj_equiv:
+  ∀ `{Countable K}, Inj equiv equiv (@GSet K _ _).
+Proof using. solve_proper. Qed.
+
+Lemma GSet_Proper: 
+  ∀ `{Countable K}, Proper (equiv ==> equiv) (@GSet K _ _).
+Proof using. solve_proper. Qed.
+
+Lemma gset_not_elem_of_equiv_not_empty_L:
+  ∀ {A : Type} `{Countable A},
+  ∀ (X : gset A), X ≠ ∅ ↔ (exists x : A, x ∈ X).
+Proof.
+  intros. split.
+  - by apply set_choose_L.
+  - set_solver. 
+Qed. 
+
+Lemma length_size `{Countable K} (g: gset K):
+  length (elements g) = size g.
+Proof.
+  rewrite -{2}(list_to_set_elements_L g).
+  rewrite size_list_to_set; [done| ]. apply NoDup_elements.
+Qed.
+
+
+Section FlattenGset.
+  Context `{Countable K}. 
+  
+  (* TODO: find existing? *)
+  Definition flatten_gset (ss: gset (gset K)): gset K :=
+    list_to_set (concat (map elements (elements ss))).
+
+  Lemma flatten_gset_spec (ss: gset (gset K)):
+    forall k, k ∈ flatten_gset ss <-> exists s, s ∈ ss /\ k ∈ s.
+  Proof.
+    intros. rewrite /flatten_gset.
+    rewrite elem_of_list_to_set.
+    rewrite elem_of_list_In in_concat.
+    setoid_rewrite in_map_iff. 
+    repeat setoid_rewrite <- elem_of_list_In.
+    split.
+    - intros (?&(l&<-&?)&?). exists l. set_solver.
+    - intros (s&?&?). exists (elements s). set_solver. 
+  Qed. 
+    
+  Lemma flatten_gset_disjoint (ss: gset (gset K)) s':
+    flatten_gset ss ## s' <-> forall s, s ∈ ss -> s ## s'.
+  Proof.
+    repeat setoid_rewrite elem_of_disjoint. setoid_rewrite flatten_gset_spec.
+    set_solver.
+  Qed.
+
+  Lemma flatten_gset_union (S1 S2: gset (gset K)):
+    flatten_gset (S1 ∪ S2) = flatten_gset S1 ∪ flatten_gset S2.
+  Proof.
+    rewrite /flatten_gset. set_solver.
+  Qed. 
+
+  Lemma flatten_gset_singleton (S: gset K):
+    flatten_gset {[ S ]} = S. 
+  Proof.
+    rewrite /flatten_gset. rewrite elements_singleton. set_solver. 
+  Qed. 
+
+  Lemma flatten_gset_empty: flatten_gset ∅ = (∅: gset K).
+  Proof using. set_solver. Qed. 
+ 
+End FlattenGset.
+
+Section GsetPick.
+  Context `{Countable K}.
+
+  Definition gset_pick  (g: gset K) :=
+    let l := elements g in
+    match l with 
+    | [] => None
+    | e :: _ => Some e
+    end.   
+  
+  Lemma gset_pick_None (g: gset K):
+    gset_pick g = None <-> g = ∅.
+  Proof.
+    rewrite /gset_pick. destruct (elements g) eqn:E.
+    - apply elements_empty_inv in E. apply leibniz_equiv_iff in E. done.
+    - split; [done| ]. intros ->. simpl in E. set_solver.
+  Qed. 
+  
+  Lemma gset_pick_is_Some (g: gset K):
+    is_Some (gset_pick g) <-> g ≠ ∅.
+  Proof.
+    rewrite -not_eq_None_Some. apply not_iff_compat, gset_pick_None. 
+  Qed. 
+  
+  Lemma gset_pick_Some (g: gset K) k:
+    gset_pick g = Some k -> k ∈ g. 
+  Proof.
+    rewrite /gset_pick. destruct elements eqn:E; [done| ].
+    intros [=->]. apply elem_of_elements. rewrite E. constructor. 
+  Qed.   
+  
+  Lemma gset_pick_singleton (k: K):
+    gset_pick {[ k ]} = Some k.
+  Proof.
+    rewrite /gset_pick. rewrite elements_singleton. done.
+  Qed. 
+
+End GsetPick.
+
+
+Section ExtractSomes.
+  Context {A: Type}.
+
+  Definition extract_Somes (l: list (option A)): list A :=
+    flat_map (from_option (fun a => [a]) []) l.
+
+  Lemma extract_Somes_spec (l: list (option A)):
+    forall a, In (Some a) l <-> In a (extract_Somes l).
+  Proof. 
+    intros. rewrite /extract_Somes.
+    rewrite in_flat_map_Exists.
+    rewrite List.Exists_exists. simpl.
+    erewrite ex_det_iff with (a := Some a). 
+    2: { intros ? [? ?]. destruct a'; try done.
+         simpl in H0. set_solver. }
+    simpl. set_solver.
+  Qed.
+
+  Context `{Countable A}. 
+
+  Definition extract_Somes_gset (s: gset (option A)): gset A :=
+    list_to_set ∘ extract_Somes ∘ elements $ s. 
+  
+  Lemma extract_Somes_gset_spec (s: gset (option A)):
+    forall a, Some a ∈ s <-> a ∈ (extract_Somes_gset s).
+  Proof. 
+    intros. rewrite /extract_Somes_gset.
+    rewrite elem_of_list_to_set. 
+    rewrite elem_of_list_In. rewrite -extract_Somes_spec.
+    rewrite -elem_of_list_In. rewrite elem_of_elements.
+    done. 
+  Qed.
+
+  Lemma extract_Somes_gset_inv (s: gset (option A)):
+    set_map Some (extract_Somes_gset s) = s ∖ {[ None ]}.
+  Proof. 
+    apply set_eq. intros ?. rewrite elem_of_map.
+    setoid_rewrite <- extract_Somes_gset_spec.
+    rewrite elem_of_difference not_elem_of_singleton.
+    split; [intros (?&->&?) | intros [??]]. 
+    - set_solver.
+    - destruct x; eauto. done.
+  Qed. 
+
+  Lemma extract_Somes_gset_singleton (ok: option A):
+    extract_Somes_gset {[ ok ]} = match ok with | Some k => {[ k ]} | None => ∅ end.
+  Proof using.
+    destruct ok; try set_solver.
+    apply set_eq. intros ?. rewrite <- extract_Somes_gset_spec.
+    set_solver.
+  Qed.
+
+End ExtractSomes.
+
+
+Lemma gset_to_gmap_singleton `{Countable K} {B: Type} (b: B) (k: K):
+  gset_to_gmap b {[ k ]} = {[ k := b ]}.
+Proof.
+  rewrite /gset_to_gmap. simpl. rewrite map_fmap_singleton. done.
+Qed. 
+
+Lemma set_Forall_subseteq {A C : Type} `{ElemOf A C}
+  (P: A → Prop) (x y: C)
+  (SUB: y ⊆ x):
+  set_Forall P x -> set_Forall P y.
+Proof using. clear -SUB. set_solver. Qed.      
+
+
+Section SetMax.
+
+  Definition set_max (X: gset nat): nat :=
+    list_max $ elements $ X.
+
+  Lemma set_max_spec X n:
+    set_max X ≤ n ↔ set_Forall (λ k, k ≤ n) X.
+  Proof using.
+    rewrite /set_max. rewrite list_max_le.
+    by rewrite set_Forall_elements.
+  Qed.
+
+  (* TODO: does it exist already? *)
+  Lemma list_max_elems X:
+    forall x, x ∈ X -> x <= list_max X.
+  Proof using.
+    induction X.
+    { set_solver. }
+    intros x. rewrite elem_of_cons. intros [->|?]; simpl. 
+    - lia.
+    - etrans; [| apply Nat.le_max_r]. eauto.
+  Qed.
+
+  Lemma set_max_elems X:
+    forall x, x ∈ X -> x <= set_max X.
+  Proof using.
+    intros x IN. rewrite /set_max.
+    apply list_max_elems. by apply elem_of_elements.
+  Qed.
+
+  Lemma set_max_singleton x:
+    set_max {[ x ]} = x.
+  Proof using.
+    rewrite /set_max. rewrite elements_singleton. simpl. lia.
+  Qed.   
+
+End SetMax.
diff --git a/heap_lang/heap_lang_defs.v b/heap_lang/heap_lang_defs.v
new file mode 100644
index 0000000..75d0d42
--- /dev/null
+++ b/heap_lang/heap_lang_defs.v
@@ -0,0 +1,288 @@
+From iris.base_logic Require Export gen_heap.
+From iris.proofmode Require Import tactics.
+From trillium.program_logic Require Export weakestpre.
+From heap_lang Require Export lang.
+From heap_lang Require Import tactics notation.
+
+
+Class heap1GpreS Σ := Heap1PreG {
+  heap1GpreS_gen_heap :: gen_heapGpreS loc val Σ;
+}.
+
+
+Class heap1GS Σ := Heap1G {
+  heap1_inG :: heap1GpreS Σ;
+  heap1_gen_heapGS :: gen_heapGS loc val Σ;
+}.
+
+Definition heap1Σ : gFunctors :=
+  #[ gen_heapΣ loc val ].
+
+
+Global Instance subG_heap1PreG {Σ}: subG heap1Σ Σ → heap1GpreS Σ.
+Proof. solve_inG. Qed.  
+
+
+Section GeneralProperties.
+  (* Context `{HGS: @heap1GS Σ}. *)
+  Context `{irisG heap_lang M Σ}. 
+
+  Lemma posts_of_empty_mapping_multiple 
+    (es e: expr) v (tid : locale heap_lang) (tp : list expr):
+    tp !! tid = Some e ->
+    to_val e = Some v ->
+    (let Φs := map fork_post (seq 0 (length tp)) in posts_of tp Φs) -∗
+    fork_post tid v.
+  Proof.
+    intros Hsome Hval. simpl.
+    
+    rewrite (big_sepL_elem_of (λ x, x.2 x.1) _ (v, fork_post tid) _) //.
+    { eauto. } 
+    apply elem_of_list_omap.
+    exists (e, (fun v => fork_post tid v)); split; last first.
+    - simpl. apply fmap_Some. exists v. split; done.
+    - destruct tp as [|e1' tp]; first set_solver. simpl.
+      apply elem_of_cons.
+      destruct tid as [|tid]; [left|right]; first by simpl in Hsome; simplify_eq.
+      apply elem_of_lookup_zip_with. eexists tid, e, _. do 2 split =>//.
+      rewrite /locale_of /=.
+      rewrite list_lookup_fmap fmap_Some. simpl in Hsome.
+      exists (S tid). split; auto.
+      rewrite lookup_seq_lt.
+      { set_solver. }
+      eapply lookup_lt_is_Some; eauto. 
+  Qed.
+
+  (* TODO: derive from previous? *)
+  Lemma posts_of_empty_mapping  (e1 e: expr) v (tid : nat) (tp : list expr):
+    tp !! tid = Some e ->
+    to_val e = Some v ->
+    cur_posts tp e1 (fun v => fork_post 0%nat v) -∗
+    fork_post tid v.
+  Proof.
+    intros Hsome Hval. simpl.
+    rewrite /cur_posts. 
+    rewrite (big_sepL_elem_of (λ x, x.2 x.1) _ (v, fork_post tid) _) //.
+    { eauto. } 
+    apply elem_of_list_omap.
+    exists (e, (fun v => fork_post tid v)); split; last first.
+    - simpl. apply fmap_Some. exists v. split; done.
+    - destruct tp as [|e1' tp]; first set_solver. simpl.
+      apply elem_of_cons.
+      destruct tid as [|tid]; [left|right]; first by simpl in Hsome; simplify_eq.
+      apply elem_of_lookup_zip_with. eexists tid, e, _. do 2 split =>//.
+      rewrite /locale_of /=.
+      rewrite list_lookup_fmap fmap_Some. simpl in Hsome.
+      exists (e1 :: take tid tp, e). rewrite drop_0. split.
+      + erewrite prefixes_from_lookup =>//.
+      + rewrite /locale_of /= length_take_le //.
+        assert (tid < length tp)%nat; last lia. by eapply lookup_lt_Some.
+  Qed.
+  
+End GeneralProperties.
+
+(** Override the notations so that scopes and coercions work out *)
+Notation "l ↦{ q } v" := (pointsto (L:=loc) (V:=val) l (DfracOwn q) v%V)
+  (at level 20, q at level 50, format "l  ↦{ q }  v") : bi_scope.
+Notation "l ↦ v" :=
+  (pointsto (L:=loc) (V:=val) l (DfracOwn 1) v%V) (at level 20) : bi_scope.
+Notation "l ↦{ q } -" := (∃ v, l ↦{q} v)%I
+  (at level 20, q at level 50, format "l  ↦{ q }  -") : bi_scope.
+Notation "l ↦ -" := (l ↦{1} -)%I (at level 20) : bi_scope.
+
+(** The tactic [inv_head_step] performs inversion on hypotheses of the shape
+[head_step]. The tactic will discharge head-reductions starting from values, and
+simplifies hypothesis related to conversions from and to values, and finite map
+operations. This tactic is slightly ad-hoc and tuned for proving our lifting
+lemmas. *)
+Ltac inv_head_step :=
+  repeat match goal with
+  | _ => progress simplify_map_eq/= (* simplify memory stuff *)
+  | H : to_val _ = Some _ |- _ => apply of_to_val in H
+  | H : head_step ?e _ _ _ _ |- _ =>
+     try (is_var e; fail 1); (* inversion yields many goals if [e] is a variable
+     and can thus better be avoided. *)
+     inversion H; subst; clear H
+  end.
+
+Global Hint Extern 0 (head_reducible _ _) => eexists _, _, _; simpl : core.
+
+(* [simpl apply] is too stupid, so we need extern hints here. *)
+Global Hint Extern 1 (head_step _ _ _ _ _) => econstructor : core.
+Global Hint Extern 0 (head_step (CmpXchg _ _ _) _ _ _ _) => eapply CmpXchgS : core.
+Global Hint Extern 0 (head_step (AllocN _ _) _ _ _ _) => apply alloc_fresh : core.
+Global Hint Resolve to_of_val : core.
+
+#[global] Instance into_val_val v : IntoVal (Val v) v.
+Proof. done. Qed.
+#[global] Instance as_val_val v : AsVal (Val v).
+Proof. by eexists. Qed.
+
+Global Ltac solve_atomic :=
+  apply strongly_atomic_atomic, ectx_language_atomic;
+    [inversion 1; naive_solver
+    |apply ectxi_language_sub_redexes_are_values; intros [] **; naive_solver].
+
+#[global] Instance rec_atomic s f x e : Atomic s (Rec f x e).
+Proof. solve_atomic. Qed.
+#[global] Instance pair_atomic s v1 v2 : Atomic s (Pair (Val v1) (Val v2)).
+Proof. solve_atomic. Qed.
+#[global] Instance injl_atomic s v : Atomic s (InjL (Val v)).
+Proof. solve_atomic. Qed.
+#[global] Instance injr_atomic s v : Atomic s (InjR (Val v)).
+Proof. solve_atomic. Qed.
+(** The instance below is a more general version of [Skip] *)
+#[global] Instance beta_atomic s f x v1 v2 : Atomic s (App (RecV f x (Val v1)) (Val v2)).
+Proof. destruct f, x; solve_atomic. Qed.
+#[global] Instance unop_atomic s op v : Atomic s (UnOp op (Val v)).
+Proof. solve_atomic. Qed.
+#[global] Instance binop_atomic s op v1 v2 : Atomic s (BinOp op (Val v1) (Val v2)).
+Proof. solve_atomic. Qed.
+#[global] Instance if_true_atomic s v1 e2 : Atomic s (If (Val $ LitV $ LitBool true) (Val v1) e2).
+Proof. solve_atomic. Qed.
+#[global] Instance if_false_atomic s e1 v2 : Atomic s (If (Val $ LitV $ LitBool false) e1 (Val v2)).
+Proof. solve_atomic. Qed.
+#[global] Instance fst_atomic s v : Atomic s (Fst (Val v)).
+Proof. solve_atomic. Qed.
+#[global] Instance snd_atomic s v : Atomic s (Snd (Val v)).
+Proof. solve_atomic. Qed.
+
+#[global] Instance fork_atomic s e : Atomic s (Fork e).
+Proof. solve_atomic. Qed.
+
+#[global] Instance alloc_atomic s v w : Atomic s (AllocN (Val v) (Val w)).
+Proof. solve_atomic. Qed.
+#[global] Instance load_atomic s v : Atomic s (Load (Val v)).
+Proof. solve_atomic. Qed.
+#[global] Instance store_atomic s v1 v2 : Atomic s (Store (Val v1) (Val v2)).
+Proof. solve_atomic. Qed.
+#[global] Instance cmpxchg_atomic s v0 v1 v2 : Atomic s (CmpXchg (Val v0) (Val v1) (Val v2)).
+Proof. solve_atomic. Qed.
+#[global] Instance faa_atomic s v1 v2 : Atomic s (FAA (Val v1) (Val v2)).
+Proof. solve_atomic. Qed.
+
+Global Ltac solve_exec_safe := intros; subst; do 3 eexists; econstructor; eauto.
+Global Ltac solve_exec_puredet := simpl; intros; by inv_head_step.
+Global Ltac solve_pure_exec :=
+  subst; intros ?; apply nsteps_once, pure_head_step_pure_step;
+    constructor; [solve_exec_safe | solve_exec_puredet].
+
+(** The behavior of the various [wp_] tactics with regard to lambda differs in
+the following way:
+
+- [wp_pures] does *not* reduce lambdas/recs that are hidden behind a definition.
+- [wp_rec] and [wp_lam] reduce lambdas/recs that are hidden behind a definition.
+
+To realize this behavior, we define the class [AsRecV v f x erec], which takes a
+value [v] as its input, and turns it into a [RecV f x erec] via the instance
+[AsRecV_recv : AsRecV (RecV f x e) f x e]. We register this instance via
+[Hint Extern] so that it is only used if [v] is syntactically a lambda/rec, and
+not if [v] contains a lambda/rec that is hidden behind a definition.
+
+To make sure that [wp_rec] and [wp_lam] do reduce lambdas/recs that are hidden
+behind a definition, we activate [AsRecV_recv] by hand in these tactics. *)
+Class AsRecV (v : val) (f x : binder) (erec : expr) :=
+  as_recv : v = RecV f x erec.
+#[global] Hint Mode AsRecV ! - - - : typeclass_instances.
+Definition AsRecV_recv f x e : AsRecV (RecV f x e) f x e := eq_refl.
+#[global] Hint Extern 0 (AsRecV (RecV _ _ _) _ _ _) =>
+  apply AsRecV_recv : typeclass_instances.
+
+#[global] Instance pure_recc f x (erec : expr) :
+  PureExec True 1 (Rec f x erec) (Val $ RecV f x erec).
+Proof. solve_pure_exec. Qed.
+#[global] Instance pure_pairc (v1 v2 : val) :
+  PureExec True 1 (Pair (Val v1) (Val v2)) (Val $ PairV v1 v2).
+Proof. solve_pure_exec. Qed.
+#[global] Instance pure_injlc (v : val) :
+  PureExec True 1 (InjL $ Val v) (Val $ InjLV v).
+Proof. solve_pure_exec. Qed.
+#[global] Instance pure_injrc (v : val) :
+  PureExec True 1 (InjR $ Val v) (Val $ InjRV v).
+Proof. solve_pure_exec. Qed.
+
+#[global] Instance pure_beta f x (erec : expr) (v1 v2 : val) `{!AsRecV v1 f x erec} :
+  PureExec True 1 (App (Val v1) (Val v2)) (subst' x v2 (subst' f v1 erec)).
+Proof. unfold AsRecV in *. solve_pure_exec. Qed.
+
+#[global] Instance pure_unop op v v' :
+  PureExec (un_op_eval op v = Some v') 1 (UnOp op (Val v)) (Val v').
+Proof. solve_pure_exec. Qed.
+
+#[global] Instance pure_binop op v1 v2 v' :
+  PureExec (bin_op_eval op v1 v2 = Some v') 1 (BinOp op (Val v1) (Val v2)) (Val v') | 10.
+Proof. solve_pure_exec. Qed.
+(* Higher-priority instance for [EqOp]. *)
+#[global] Instance pure_eqop v1 v2 :
+  PureExec (vals_compare_safe v1 v2) 1
+    (BinOp EqOp (Val v1) (Val v2))
+    (Val $ LitV $ LitBool $ bool_decide (v1 = v2)) | 1.
+Proof.
+  intros Hcompare.
+  cut (bin_op_eval EqOp v1 v2 = Some $ LitV $ LitBool $ bool_decide (v1 = v2)).
+  { intros. revert Hcompare. solve_pure_exec. }
+  rewrite /bin_op_eval /= decide_True //.
+Qed.
+
+#[global] Instance pure_if_true e1 e2 : PureExec True 1 (If (Val $ LitV $ LitBool true) e1 e2) e1.
+Proof. solve_pure_exec. Qed.
+
+#[global] Instance pure_if_false e1 e2 : PureExec True 1 (If (Val $ LitV  $ LitBool false) e1 e2) e2.
+Proof. solve_pure_exec. Qed.
+
+#[global] Instance pure_fst v1 v2 :
+  PureExec True 1 (Fst (Val $ PairV v1 v2)) (Val v1).
+Proof. solve_pure_exec. Qed.
+
+#[global] Instance pure_snd v1 v2 :
+  PureExec True 1 (Snd (Val $ PairV v1 v2)) (Val v2).
+Proof. solve_pure_exec. Qed.
+
+#[global] Instance pure_case_inl v e1 e2 :
+  PureExec True 1 (Case (Val $ InjLV v) e1 e2) (App e1 (Val v)).
+Proof. solve_pure_exec. Qed.
+
+#[global] Instance pure_case_inr v e1 e2 :
+  PureExec True 1 (Case (Val $ InjRV v) e1 e2) (App e2 (Val v)).
+Proof. solve_pure_exec. Qed.
+
+
+Section Heap.
+  Context `{HGS: @heap1GS Σ}.
+
+  (** Heap *)
+  (** The usable rules for [allocN] stated in terms of the [array] proposition
+are   derived in te file [array]. *)
+  Lemma heap_array_to_seq_meta l vs (n : nat) :
+    length vs = n →
+    ([∗ map] l' ↦ _ ∈ heap_array l vs, meta_token l' ⊤) -∗
+      [∗ list] i ∈ seq 0 n, meta_token (l +ₗ (i : nat)) ⊤.
+  Proof.
+    iIntros (<-) "Hvs". iInduction vs as [|v vs] "IH" forall (l)=> //=.
+    rewrite big_opM_union; last first.
+    { apply map_disjoint_spec=> l' v1 v2 /lookup_singleton_Some [-> _].
+    intros (j&?&Hjl&_)%heap_array_lookup.
+    rewrite loc_add_assoc -{1}[l']loc_add_0 in Hjl. simplify_eq; lia. }
+    rewrite loc_add_0 -fmap_S_seq big_sepL_fmap.
+    setoid_rewrite Nat2Z.inj_succ. setoid_rewrite <-Z.add_1_l.
+    setoid_rewrite <-loc_add_assoc.
+    rewrite big_opM_singleton; iDestruct "Hvs" as "[$ Hvs]". by iApply "IH".
+  Qed.
+
+  Lemma heap_array_to_seq_mapsto l v (n : nat) :
+    ([∗ map] l' ↦ v ∈ heap_array l (replicate n v), l' ↦ v) -∗
+  [∗ list] i ∈ seq 0 n, (l +ₗ (i : nat)) ↦ v.
+  Proof.
+    iIntros "Hvs". iInduction n as [|n] "IH" forall (l); simpl.
+    { done. }
+    rewrite big_opM_union; last first.
+    { apply map_disjoint_spec=> l' v1 v2 /lookup_singleton_Some [-> _].
+      intros (j&?&Hjl&_)%heap_array_lookup.
+      rewrite loc_add_assoc -{1}[l']loc_add_0 in Hjl. simplify_eq; lia. }
+    rewrite loc_add_0 -fmap_S_seq big_sepL_fmap.
+    setoid_rewrite Nat2Z.inj_succ. setoid_rewrite <-Z.add_1_l.
+    setoid_rewrite <-loc_add_assoc.
+    rewrite big_opM_singleton; iDestruct "Hvs" as "[$ Hvs]". by iApply "IH".
+  Qed.
+
+End Heap.
diff --git a/fairis/heap_lang/lang.v b/heap_lang/lang.v
similarity index 99%
rename from fairis/heap_lang/lang.v
rename to heap_lang/lang.v
index 68737d1..aa693e8 100644
--- a/fairis/heap_lang/lang.v
+++ b/heap_lang/lang.v
@@ -1,8 +1,8 @@
 From stdpp Require Export binders strings.
 From stdpp Require Import gmap.
 From iris.algebra Require Export ofe.
-From trillium.program_logic Require Export language ectx_language ectxi_language adequacy.
-From trillium.fairness.heap_lang Require Export locations.
+From trillium Require Export language ectx_language ectxi_language adequacy.
+From heap_lang Require Export locations.
 Set Default Proof Using "Type".
 
 (** heap_lang.  A fairly simple language used for common Iris examples.
@@ -695,7 +695,7 @@ Lemma heap_locale_injective tp0 e0 tp1 tp e :
   locale_of tp0 e0 ≠ locale_of tp e.
 Proof.
   intros (?&?&->&?)%prefixes_from_spec.
-  rewrite /locale_of !app_length /=. lia.
+  rewrite /locale_of !length_app /=. lia.
 Qed.
 
 Lemma heap_lang_mixin : EctxiLanguageMixin of_val to_val fill_item head_step locale_of.
diff --git a/heap_lang/locales_helpers_hl.v b/heap_lang/locales_helpers_hl.v
new file mode 100644
index 0000000..7a77635
--- /dev/null
+++ b/heap_lang/locales_helpers_hl.v
@@ -0,0 +1,143 @@
+From fairness Require Import locales_helpers utils_sets.
+From heap_lang Require Export lang tactics notation.
+
+  
+Lemma from_locale_from_lookup tp0 tp tid e :
+  from_locale_from tp0 tp tid = Some e <-> (tp !! (tid - length tp0)%nat = Some e ∧ (length tp0 <= tid)%nat).
+Proof.
+  split.
+  - revert tp0 tid. induction tp as [| e1 tp1 IH]; intros tp0 tid.
+    { unfold from_locale. simpl. done. }
+    unfold from_locale. simpl.
+    destruct (decide (locale_of tp0 e1 = tid)).
+    + intros ?; simplify_eq. rewrite /locale_of /= Nat.sub_diag.
+      split; [done|lia].
+    + intros [H Hlen]%IH. rewrite length_app /= in H.
+      rewrite length_app /= in Hlen.
+      destruct tid as [|tid]; first lia.
+      assert (Heq1 : (length tp0 + 1 = S (length tp0))%nat) by lia.
+      rewrite Heq1 in Hlen.
+      assert (length tp0 ≤ tid)%nat by lia.
+      assert (Heq : (S tid - length tp0)%nat = (S ((tid - (length tp0))))%nat) by lia.
+      rewrite Heq /=. split.
+      * rewrite -H. f_equal. lia.
+      * transitivity tid; try lia. assumption.
+  - revert tp0 tid. induction tp as [|e1 tp1 IH]; intros tp0 tid.
+    { set_solver. }
+    destruct (decide (tid = length tp0)) as [-> | Hneq].
+    + rewrite Nat.sub_diag /=. intros  [? _]. simplify_eq.
+      rewrite decide_True //.
+    + intros [Hlk Hlen]. assert (length tp0 < tid)%nat as Hle by lia.
+      simpl. rewrite decide_False //. apply IH. split.
+      * assert (tid - length tp0 = S ((tid - 1) - length tp0))%nat as Heq by lia.
+        rewrite Heq /= in Hlk. rewrite -Hlk length_app /=. f_equal; lia.
+      * rewrite length_app /=. apply Nat.le_succ_l in Hle. rewrite Nat.add_comm //.
+Qed.
+
+  
+Lemma from_locale_lookup tp tid e :
+  from_locale tp tid = Some e <-> tp !! tid = Some e.
+Proof.
+  assert (from_locale tp tid = Some e <-> (tp !! tid = Some e ∧ 0 ≤ tid)%nat) as H; last first.
+  { split; intros ?; apply H; eauto. split; [done|lia]. }
+  unfold from_locale. replace (tid) with (tid - length (A := expr) [])%nat at 2;
+    first apply from_locale_from_lookup. simpl; lia.
+Qed.
+
+Definition indexes {A} (xs : list A) := imap (λ i _, i) xs.
+
+Lemma locales_of_list_from_indexes (es' es : list expr) :
+  locales_of_list_from es' es = imap (λ i _, length es' + i)%nat es.
+Proof.
+  revert es'. induction es; [done|]; intros es'.
+  rewrite locales_of_list_from_cons=> /=. rewrite /locale_of.
+  f_equiv; [lia|]. rewrite IHes. apply imap_ext.
+  intros x ? Hin. rewrite length_app=> /=. lia.
+Qed.
+
+Lemma locales_of_list_indexes (es : list expr) :
+  locales_of_list es = indexes es.
+Proof. apply locales_of_list_from_indexes. Qed.
+
+Lemma locales_of_cfg_simpl l σ:
+  locales_of_cfg (l, σ) = set_seq 0 (length l).
+Proof. 
+  rewrite /locales_of_cfg. f_equal. simpl.
+  rewrite !locales_of_list_from_indexes. simpl.
+  rewrite !imap_seq_0. rewrite !list_fmap_id.
+  apply list_to_set_seq.
+Qed. 
+
+Lemma length_upd_middle {A: Type} (x y: A) l1 l2:
+  length (l1 ++ x :: l2) = length (l1 ++ y :: l2).
+Proof.  intros. rewrite !length_app. simpl. lia. Qed.
+
+Lemma locale_step_sub c1 c2 τ
+  (STEP: locale_step c1 (Some τ) c2):
+  locales_of_cfg c1 ⊆ locales_of_cfg c2. 
+Proof.
+  inversion STEP. subst.
+  
+  rewrite !locales_of_cfg_simpl. 
+  rewrite app_comm_cons. rewrite app_assoc. rewrite (length_app _ efs). 
+  rewrite -!list_to_set_seq. rewrite seq_app.
+  rewrite list_to_set_app.
+  rewrite (length_upd_middle e1 e2). set_solver.
+Qed. 
+
+Lemma locale_step_fresh_exact c1 c2 τ τ'
+  (STEP: locale_step c1 (Some τ) c2)
+  (FRESH: τ' ∈ locales_of_cfg c2 ∖ locales_of_cfg c1):
+  locales_of_cfg c2 = locales_of_cfg c1 ∪ {[ τ' ]} /\ τ' ∉ locales_of_cfg c1.
+Proof.
+  inversion STEP. subst.
+  revert FRESH.
+  
+  rewrite !locales_of_cfg_simpl. 
+  rewrite app_comm_cons. rewrite app_assoc. rewrite length_app.
+  rewrite -!list_to_set_seq. rewrite seq_app. simpl. 
+  rewrite list_to_set_app_L. rewrite !list_to_set_seq.
+  
+  rewrite (length_upd_middle e2 e1). remember (length (t1 ++ e1 :: t2)) as N.
+  rewrite -HeqN. remember (set_seq 0 N) as D. 
+  
+  rewrite difference_union_distr_l_L. rewrite subseteq_empty_difference; [| done].
+  rewrite union_empty_l. intros [DOM2 NDOM1]%elem_of_difference.
+  split; [| done].
+  f_equal.
+  
+  assert (¬ (efs = [])) as FORK.
+  { intros NOFORK. inversion H3. subst. inversion H1; subst; done. }
+  inversion H3. subst. inversion H1; subst; try done.
+  simpl in DOM2. rewrite union_empty_r in DOM2. apply elem_of_singleton in DOM2.
+  simpl. set_solver.
+Qed.            
+
+Lemma locale_step_fork_Some c1 τ c2 τ'
+  (STEP: locale_step c1 (Some τ) c2)
+  (FORK: step_fork c1 c2 = Some τ'):
+  locales_of_cfg c2 = locales_of_cfg c1 ∪ {[τ']} ∧ τ' ∉ locales_of_cfg c1.
+Proof using.
+  apply gset_pick_Some in FORK.
+  eapply locale_step_fresh_exact in FORK; eauto.
+Qed.
+
+
+(* TODO: found in Fairis, might have duplicates somewhere above/around *)
+(****************)
+
+Lemma heap_lang_locales_equiv_from_length (es10 es1 es20 es2 : list expr) :
+  length es10 = length es20 → length es1 = length es2 →
+  locales_equiv_from es10 es20 es1 es2.
+Proof.
+  revert es10 es20 es2.
+  induction es1 as [|e es1 IHes1]; intros es10 es20 es2 Hlen; [by destruct es2|].
+  destruct es2; [done|]=> /=. constructor; [done|].
+  apply IHes1; [by rewrite !length_app=> /=;f_equiv|lia].
+Qed.
+
+Lemma heap_lang_locales_equiv_length (es1 es2 : list expr) :
+  length es1 = length es2 → locales_equiv es1 es2.
+Proof. intros Hlen. by apply heap_lang_locales_equiv_from_length. Qed.  
+
+(****************)
diff --git a/fairis/heap_lang/locations.v b/heap_lang/locations.v
similarity index 100%
rename from fairis/heap_lang/locations.v
rename to heap_lang/locations.v
diff --git a/fairis/heap_lang/notation.v b/heap_lang/notation.v
similarity index 99%
rename from fairis/heap_lang/notation.v
rename to heap_lang/notation.v
index c43d8ce..d70384e 100644
--- a/fairis/heap_lang/notation.v
+++ b/heap_lang/notation.v
@@ -1,5 +1,5 @@
 From trillium.program_logic Require Import language.
-From trillium.fairness.heap_lang Require Export lang.
+From heap_lang Require Export lang.
 Set Default Proof Using "Type".
 
 Delimit Scope expr_scope with E.
diff --git a/heap_lang/sswp_logic.v b/heap_lang/sswp_logic.v
new file mode 100644
index 0000000..d888894
--- /dev/null
+++ b/heap_lang/sswp_logic.v
@@ -0,0 +1,246 @@
+From stdpp Require Import fin_maps.
+From iris.proofmode Require Import tactics.
+From iris.base_logic Require Export gen_heap.
+From heap_lang Require Export heap_lang_defs. 
+From heap_lang Require Import tactics notation.
+
+
+Section SSWP.
+  Set Default Proof Using "Type".
+
+  Context `{hGS: @heap1GS Σ}.
+  Context {iGS: invGS_gen HasNoLc Σ}. 
+  
+  Definition sswp (s : stuckness) E e1 (Φ : expr → iProp Σ) : iProp Σ :=
+    match to_val e1 with
+    | Some v => |={E}=> (Φ (of_val v))
+    | None => ∀ σ1,
+        gen_heap_interp σ1.(heap) ={E,∅}=∗
+       ⌜if s is NotStuck then reducible e1 σ1 else True⌝ ∗
+       ∀ e2 σ2 efs,
+         ⌜prim_step e1 σ1 e2 σ2 efs⌝ ={∅}▷=∗ |={∅,E}=>
+         gen_heap_interp σ2.(heap) ∗ Φ e2 ∗ ⌜efs = []⌝
+    end%I.
+
+  Lemma sswp_wand s e E (Φ Ψ : expr → iProp Σ) :
+    (∀ e, Φ e -∗ Ψ e) -∗ sswp s E e Φ -∗ sswp s E e Ψ.
+  Proof.
+    rewrite /sswp. iIntros "HΦΨ HΦ".
+    destruct (to_val e); [by iApply "HΦΨ"|].
+    iIntros (?) "H". iMod ("HΦ" with "H") as "[%Hs HΦ]".
+    iModIntro. iSplit; [done|]. iIntros (????).
+    iDestruct ("HΦ" with "[//]") as "HΦ".
+    iMod "HΦ". iIntros "!>!>". iMod "HΦ". iIntros "!>". iMod "HΦ" as "(?&?&?)".
+    iIntros "!>". iFrame. by iApply "HΦΨ".
+  Qed.
+
+  Lemma sswp_fupd s (E E': coPset) e Φ
+    (NVAL: language.to_val e = None):
+    (|={E, E'}=> (sswp s E' e (fun k => |={E', E}=> Φ k))) -∗ (sswp s E e Φ).
+  Proof using.
+    iIntros "WP". rewrite /sswp.
+    simpl in *. rewrite NVAL. iIntros (?) "HEAP".
+    iMod ("WP" with "[$]") as "WP". iMod "WP" as "[? WP]". iModIntro.
+    iFrame. iIntros. iMod ("WP" with "[//]") as "X".
+    iModIntro. iNext. iMod "X". iModIntro. iMod "X" as "(X & Y & Z)". iFrame.
+    done.
+  Qed.
+
+  Lemma sswp_pure_step s E e1 e2 (Φ : Prop) Ψ :
+    PureExec Φ 1 e1 e2 → Φ → ▷ Ψ e2 -∗ sswp s E e1 Ψ%I.
+  Proof.
+    iIntros (Hpe HΦ) "HΨ".
+    assert (pure_step e1 e2) as Hps.
+    { specialize (Hpe HΦ). by apply nsteps_once_inv in Hpe. }
+    rewrite /sswp /=.
+    assert (to_val e1 = None) as ->.
+    { destruct Hps as [Hred _]. specialize (Hred (Build_state ∅ ∅)).
+      by eapply reducible_not_val. }
+    iIntros (σ) "Hσ".
+    iMod fupd_mask_subseteq as "Hclose"; last iModIntro; [by set_solver|].
+    iSplit.
+    { destruct s; [|done]. by destruct Hps as [Hred _]. }
+    iIntros (e2' σ2 efs Hstep) "!>!>!>".
+    iMod "Hclose". iModIntro. destruct Hps as [_ Hstep'].
+    apply Hstep' in Hstep as [-> [-> ->]]. by iFrame.
+  Qed.
+  
+  (* Local Hint Extern 0 (head_reducible _ _) => eexists _, _, _; simpl : core. *)
+  (* Local Hint Extern 1 (head_step _ _ _ _ _) => econstructor : core. *)
+  (* Local Hint Extern 0 (head_step (CmpXchg _ _ _) _ _ _ _) => eapply CmpXchgS : core. *)
+  (* Local Hint Extern 0 (head_step (AllocN _ _) _ _ _ _) => apply alloc_fresh : core. *)
+  (* Local Hint Resolve to_of_val : core. *)
+  
+  (* #[global] Instance into_val_val v : IntoVal (Val v) v. *)
+  (* Proof. done. Qed. *)
+  (* #[global] Instance as_val_val v : AsVal (Val v). *)
+  (* Proof. by eexists. Qed. *)
+  
+  Lemma wp_allocN_seq s E v n (Φ : expr → iProp Σ) :
+    0 < n →
+    ▷ (∀ (l:loc), ([∗ list] i ∈ seq 0 (Z.to_nat n),
+                    (l +ₗ (i : nat)) ↦ v ∗ meta_token (l +ₗ (i : nat)) ⊤) -∗ Φ #l) -∗
+      sswp s E (AllocN (Val $ LitV $ LitInt $ n) (Val v)) Φ.
+  Proof.
+    iIntros (HnO) "HΦ".
+    rewrite /sswp. simpl.
+    iIntros (σ) "Hσ".
+    iMod fupd_mask_subseteq as "Hclose"; last iModIntro; first by set_solver.
+    iSplit.
+    { iPureIntro. destruct s; [|done]. apply head_prim_reducible. eauto. }
+    iIntros (e2 σ2 efs Hstep). iIntros "!>!>!>".
+    iMod "Hclose".
+    apply head_reducible_prim_step in Hstep; [|eauto].
+    inv_head_step.
+    iMod (gen_heap_alloc_big _ (heap_array l (replicate (Z.to_nat n) v)) with "Hσ")
+      as "(Hσ & Hl & Hm)".
+    { apply heap_array_map_disjoint.
+      rewrite length_replicate Z2Nat.id ?Hexend; auto with lia. }
+    iFrame.
+    iModIntro.
+    iSplit; [|done].
+    iApply "HΦ".
+    iApply big_sepL_sep. iSplitL "Hl".
+    + by iApply heap_array_to_seq_mapsto.
+    + iApply (heap_array_to_seq_meta with "Hm"). by rewrite length_replicate.
+  Qed.
+  
+  Lemma wp_alloc s E v (Φ : expr → iProp Σ) :
+    ▷ (∀ l, l ↦ v -∗ meta_token l ⊤ -∗ Φ (LitV (LitLoc l))) -∗
+      sswp s E (Alloc v) Φ.
+  Proof.
+    iIntros "HΦ". iApply wp_allocN_seq; [lia|].
+    iIntros "!>" (l) "[[Hl Hm] _]". rewrite loc_add_0.
+    iApply ("HΦ" with "Hl Hm").
+  Qed.
+  
+  Lemma wp_choose_nat s E (Φ : expr → iProp Σ) :
+    ▷ (∀ (n:nat), Φ $ Val $ LitV (LitInt n)) -∗
+      sswp s E ChooseNat Φ.
+  Proof.
+    iIntros "HΦ".
+    rewrite /sswp. simpl.
+    iIntros (σ) "Hσ".
+    iMod fupd_mask_subseteq as "Hclose"; last iModIntro; first by set_solver.
+    iSplit.
+    { iPureIntro. destruct s; [|done]. apply head_prim_reducible. eauto. }
+    iIntros (e2 σ2 efs Hstep). iIntros "!>!>!>".
+    iMod "Hclose".
+    apply head_reducible_prim_step in Hstep; [|eauto].
+    inv_head_step.
+    iFrame.
+    iModIntro.
+    iSplit; [|done].
+    iApply "HΦ".
+    Unshelve. all: apply O.
+  Qed.
+  
+  Lemma wp_load s E l q v (Φ : expr → iProp Σ) :
+    ▷ l ↦{q} v -∗
+      ▷ (l ↦{q} v -∗ Φ v) -∗
+      sswp s E (Load (Val $ LitV $ LitLoc l)) Φ.
+  Proof.
+    iIntros ">Hl HΦ".
+    rewrite /sswp. simpl.
+    iIntros (σ) "Hσ".
+    iMod fupd_mask_subseteq as "Hclose"; last iModIntro; first by set_solver.
+    iDestruct (@gen_heap_valid with "Hσ Hl") as %Hheap.
+    iSplit.
+    { iPureIntro. destruct s; [|done]. apply head_prim_reducible. eauto. }
+    iIntros (e2 σ2 efs Hstep). iIntros "!>!>!>".
+    iMod "Hclose".
+    apply head_reducible_prim_step in Hstep; [|eauto].
+    inv_head_step.
+    iFrame.
+    iModIntro.
+    iSplit; [|done].
+    by iApply "HΦ".
+  Qed.
+  
+  Lemma wp_store s E l v' v (Φ : expr → iProp Σ) :
+    ▷ l ↦ v' -∗
+      ▷ (l ↦ v -∗ Φ $ LitV LitUnit) -∗
+      sswp s E (Store (Val $ LitV (LitLoc l)) (Val v)) Φ.
+  Proof.
+    iIntros ">Hl HΦ". simpl.
+    iIntros (σ1) "Hsi".
+    iDestruct (gen_heap_valid with "Hsi Hl") as %Hheap.
+    iApply fupd_mask_intro; [set_solver|]. iIntros "Hclose".
+    iSplit.
+    { destruct s; [|done]. iPureIntro. apply head_prim_reducible. by eauto. }
+    iIntros (e2 σ2 efs Hstep). iIntros "!>!>!>".
+    iMod "Hclose".
+    iMod (@gen_heap_update with "Hsi Hl") as "[Hsi Hl]".
+    iFrame.
+    apply head_reducible_prim_step in Hstep; [|by eauto].
+    inv_head_step. iFrame. iModIntro. iSplit; [|done]. by iApply "HΦ".
+  Qed.
+  
+  Lemma wp_cmpxchg_fail s E l q v' v1 v2 (Φ : expr → iProp Σ) :
+    v' ≠ v1 → vals_compare_safe v' v1 →
+    ▷ l ↦{q} v' -∗
+      ▷ (l ↦{q} v' -∗ Φ $ PairV v' (LitV $ LitBool false)) -∗
+      sswp s E (CmpXchg (Val $ LitV $ LitLoc l) (Val v1) (Val v2)) Φ.
+  Proof.
+    iIntros (??) ">Hl HΦ". simpl.
+    iIntros (σ1) "Hsi".
+    iDestruct (gen_heap_valid with "Hsi Hl") as %Hheap.
+    iApply fupd_mask_intro; [set_solver|]. iIntros "Hclose".
+    iSplit.
+    { destruct s; [|done]. iPureIntro. apply head_prim_reducible. by eauto. }
+    iIntros (e2 σ2 efs Hstep). iIntros "!>!>!>".
+    iMod "Hclose".
+    iFrame.
+    apply head_reducible_prim_step in Hstep; [|by eauto].
+    inv_head_step.
+    rewrite bool_decide_false //. iFrame. iModIntro.
+    iSplit; [|done].
+    by iApply "HΦ".
+  Qed.
+  
+  Lemma wp_cmpxchg_suc s E l v' v1 v2 (Φ : expr → iProp Σ) :
+      v' = v1 → vals_compare_safe v' v1 →
+      ▷ l ↦ v' -∗
+      ▷ (l ↦ v2 -∗ Φ $ PairV v' (LitV $ LitBool true)) -∗
+      sswp s E (CmpXchg (Val $ LitV $ LitLoc l) (Val v1) (Val v2)) Φ.
+  Proof.
+    iIntros (??) ">Hl HΦ". simpl.
+    iIntros (σ1) "Hsi".
+    iDestruct (gen_heap_valid with "Hsi Hl") as %Hheap.
+    iApply fupd_mask_intro; [set_solver|]. iIntros "Hclose".
+    iSplit.
+    { destruct s; [|done]. iPureIntro. apply head_prim_reducible. by eauto. }
+    iIntros (e2 σ2 efs Hstep). iIntros "!>!>!>".
+    iMod (@gen_heap_update with "Hsi Hl") as "[Hsi Hl]".
+    iMod "Hclose".
+    iFrame.
+    apply head_reducible_prim_step in Hstep; [|by eauto].
+    inv_head_step.
+    rewrite bool_decide_true //. iFrame. iModIntro.
+    iSplit; [|done].
+    by iApply "HΦ".
+  Qed.
+    
+  Lemma wp_faa s E (l: loc) (i a: Z) (Φ : expr → iProp Σ) :
+    ▷ l ↦ #i -∗
+    ▷ (l ↦ #(i + a) -∗ Φ #i) -∗
+    sswp s E (FAA #l #a) Φ. 
+  Proof.
+    iIntros ">Hl HΦ". simpl.
+    iIntros (σ1) "Hsi".
+    iDestruct (gen_heap_valid with "Hsi Hl") as %Hheap.
+    iApply fupd_mask_intro; [set_solver|]. iIntros "Hclose".
+    iSplit.
+    { destruct s; [|done]. iPureIntro. apply head_prim_reducible. by eauto. }
+    iIntros (e2 σ2 efs Hstep). iIntros "!>!>!>".
+    iMod (@gen_heap_update with "Hsi Hl") as "[Hsi Hl]".
+    iMod "Hclose".
+    iFrame.
+    apply head_reducible_prim_step in Hstep; [|by eauto].
+    inv_head_step.
+    iFrame. iModIntro.
+    iSplit; [|done].
+    by iApply "HΦ".
+  Qed.
+
+End SSWP.
diff --git a/fairis/heap_lang/tactics.v b/heap_lang/tactics.v
similarity index 98%
rename from fairis/heap_lang/tactics.v
rename to heap_lang/tactics.v
index e13b022..52f287f 100644
--- a/fairis/heap_lang/tactics.v
+++ b/heap_lang/tactics.v
@@ -1,4 +1,4 @@
-From trillium.fairness.heap_lang Require Export lang.
+From heap_lang Require Export lang.
 Set Default Proof Using "Type".
 Import heap_lang.
 
diff --git a/make-package b/make-package
new file mode 100755
index 0000000..9171aa1
--- /dev/null
+++ b/make-package
@@ -0,0 +1,23 @@
+#!/bin/bash
+# A simplified version of Iris project build script.
+set -e
+
+PROJECT="$1"
+shift
+
+COQFILE="_CoqProject.$PROJECT"
+MAKEFILE="Makefile.package.$PROJECT"
+
+# Generate _CoqProject file and Makefile
+rm -f "$COQFILE"
+cp _CoqProject "$COQFILE"
+# Get the files.
+find "$PROJECT/" -type f -name "*.v" >> "$COQFILE"
+# Now we can run coq_makefile.
+"${COQBIN}coq_makefile" -f "$COQFILE" -o "$MAKEFILE"
+
+# Run build
+make -f "$MAKEFILE" "$@"
+
+# Cleanup
+rm -f ".$MAKEFILE.d" "$MAKEFILE"*
diff --git a/trillium.opam b/trillium.opam
new file mode 100644
index 0000000..c882eb9
--- /dev/null
+++ b/trillium.opam
@@ -0,0 +1,15 @@
+opam-version: "2.0"
+name: "trillium"
+version: "2.0.0"
+synopsis: "Coq development of the Trillium framework"
+maintainer: "Trillium Team"
+authors: "Trillium Team"
+license: "MIT"
+build: ["./make-package" "trillium" "-j%{jobs}%"]
+install: ["./make-package" "trillium" "install"]
+depends: [
+  "coq" { (= "9.0.0") }
+  "coq-iris" { (= "4.3.0") }
+  "coq-stdpp" { (="1.11.0") }
+  "coq-paco" { (= "4.2.3") }
+]
\ No newline at end of file
diff --git a/trillium/bi/weakestpre.v b/trillium/bi/weakestpre.v
index 324f7c8..1b828cd 100644
--- a/trillium/bi/weakestpre.v
+++ b/trillium/bi/weakestpre.v
@@ -30,7 +30,7 @@ different [A], the plan is to generalize the notation to use [Inhabited] instead
 to pick a default value depending on [A]. *)
 Class Wp (Λ : language) (PROP A : Type) :=
   wp : A → coPset -> locale Λ -> expr Λ → (val Λ → PROP) → PROP.
-Arguments wp {_ _ _ _} _ _ _ _%E _%I.
+Arguments wp {_ _ _ _} _ _ _ %_E %_I.
 #[global] Instance: Params (@wp) 8 := {}.
 
 (** Notations for partial weakest preconditions *)
diff --git a/trillium/events/event.v b/trillium/events/event.v
index 63287b7..12a1716 100644
--- a/trillium/events/event.v
+++ b/trillium/events/event.v
@@ -128,7 +128,7 @@ Section properties.
     { simpl.
       assert (length tp1' < length tp1 + S (length tp2)); last lia.
       pose proof (f_equal length Heq1) as Heq'.
-      rewrite !app_length //= in Heq'; lia. }
+      rewrite !length_app //= in Heq'; lia. }
     destruct (length tp1' - length tp1); last first.
     { simpl in *.
       rewrite Heq1' in Heq2'; simplify_eq.
@@ -329,7 +329,7 @@ Section properties.
     rewrite Hevs2 in Hevs'2; rewrite Hevs'2.
     rewrite -app_assoc.
     eexists; split_and!; [|done|].
-    { rewrite !app_length /=; lia. }
+    { rewrite !length_app /=; lia. }
     intros ev oζ1 oζ2 [Hev|Hev]%elem_of_app.
     - destruct (Hevs3 ev oζ1 oζ2 Hev) as (i & c1 & c2 & oζ1' & oζ2' & Hc1 & Hc2 & Htrg).
       exists i, c1, c2, oζ1', oζ2'.
diff --git a/trillium/prelude/classical.v b/trillium/prelude/classical.v
index daf7149..bee8c05 100644
--- a/trillium/prelude/classical.v
+++ b/trillium/prelude/classical.v
@@ -1,4 +1,4 @@
-From Coq.Unicode Require Import Utf8.
+From Stdlib.Unicode Require Import Utf8.
 
 Axiom FunExt :
   ∀ (A : Type) (B : A → Type) (f g : ∀ x, B x), (∀ x, f x = g x) → f = g.
diff --git a/trillium/prelude/finitary.v b/trillium/prelude/finitary.v
index 21cdfda..8224541 100644
--- a/trillium/prelude/finitary.v
+++ b/trillium/prelude/finitary.v
@@ -1,5 +1,5 @@
-From Coq.Unicode Require Import Utf8.
-From Coq.micromega Require Import Lia.
+From Stdlib.Unicode Require Import Utf8.
+From Stdlib.micromega Require Import Lia.
 From trillium.prelude Require Import
      classical quantifiers sigma classical_instances.
 From stdpp Require Import finite fin_sets gmap list.
@@ -86,7 +86,7 @@ Section smaller_card_nat_finite.
       length (no_fin_make_list l n) = length l + n.
     Proof.
       induction n as [|n IHn]; [simpl; lia|].
-      simpl; rewrite app_length, IHn; simpl; lia.
+      simpl; rewrite length_app, IHn; simpl; lia.
     Qed.
 
     Lemma no_fin_make_list_prefix l n1 n2 :
@@ -362,8 +362,8 @@ Section in_list_finite.
 
 End in_list_finite.
 
-Require Import Coq.Logic.Epsilon.
-Require Import Coq.Sorting.Permutation.
+Require Import Stdlib.Logic.Epsilon.
+Require Import Stdlib.Sorting.Permutation.
 
 Section finite_range_gmap.
   Context `{!EqDecision K, !Countable K}.
diff --git a/trillium/prelude/fixpoint.v b/trillium/prelude/fixpoint.v
index ccf39e8..5f1c62d 100644
--- a/trillium/prelude/fixpoint.v
+++ b/trillium/prelude/fixpoint.v
@@ -1,5 +1,5 @@
-From Coq.Unicode Require Import Utf8.
-From Coq.ssr Require Import ssreflect.
+From Stdlib.Unicode Require Import Utf8.
+From Stdlib.ssr Require Import ssreflect.
 
 Definition monotone {A} (Ψ : (A → Prop) → (A → Prop)) :=
   ∀ (P Q : A → Prop), (∀ x, P x → Q x) → ∀ x, Ψ P x → Ψ Q x.
diff --git a/trillium/prelude/quantifiers.v b/trillium/prelude/quantifiers.v
index d90273f..aac6120 100644
--- a/trillium/prelude/quantifiers.v
+++ b/trillium/prelude/quantifiers.v
@@ -1,5 +1,5 @@
-From Coq.Unicode Require Import Utf8.
-From Coq.micromega Require Import Lia.
+From Stdlib.Unicode Require Import Utf8.
+From Stdlib.micromega Require Import Lia.
 From trillium.prelude Require Import classical sigma.
 
 Definition injective {A B} (f : A → B) := ∀ x y, f x = f y → x = y.
diff --git a/trillium/prelude/sigma.v b/trillium/prelude/sigma.v
index 8d32aac..b530533 100644
--- a/trillium/prelude/sigma.v
+++ b/trillium/prelude/sigma.v
@@ -1,7 +1,7 @@
-From Coq.Unicode Require Import Utf8.
+From Stdlib.Unicode Require Import Utf8.
 From stdpp Require Import base list.
 From trillium.prelude Require Import classical.
-From Coq.ssr Require Import ssreflect.
+From Stdlib.ssr Require Import ssreflect.
 
 Lemma sig_eq {A} (P : A → Prop) (x y : sig P) :
   proj1_sig x = proj1_sig y → x = y.
diff --git a/trillium/program_logic/adequacy.v b/trillium/program_logic/adequacy.v
index 30cc282..17e994f 100644
--- a/trillium/program_logic/adequacy.v
+++ b/trillium/program_logic/adequacy.v
@@ -14,7 +14,7 @@ Lemma step_tp_length {Λ} c c' oζ:
   locale_step (Λ := Λ) c oζ c' → length c.1 ≤ length c'.1.
 Proof.
   inversion 1; simplify_eq; last done.
-  rewrite !app_length /= !app_length; lia.
+  rewrite !length_app /= !length_app; lia.
 Qed.
 
 Lemma valid_exec_length {Λ} ex (tp1 tp2 : list $ expr Λ) σ1 σ2:
@@ -149,10 +149,10 @@ Section locales_helpers.
     - destruct t2; first done.
       revert e a t0 t0' t1 t2' t2 IHt2' Hlen Hequiv. induction t1'; intros x y t0 t0' t1 t2' t2 IHt2' Hlen Hequiv.
       + destruct t1; first by simpl; constructor; list_simplifier.
-        apply Forall2_length in Hequiv. rewrite !prefixes_from_length app_length /= in Hequiv.
+        apply Forall2_length in Hequiv. rewrite !prefixes_from_length length_app /= in Hequiv.
         simpl in Hlen. lia.
       + destruct t1.
-        { apply Forall2_length in Hequiv. rewrite !prefixes_from_length !app_length /= in Hequiv.
+        { apply Forall2_length in Hequiv. rewrite !prefixes_from_length !length_app /= in Hequiv.
           simpl in Hlen. lia. }
         assert (H: locales_equiv_from (t0 ++ e :: t1) (t0' ++ a :: t1')
                     (x :: t2) (y :: t2')).
@@ -224,7 +224,7 @@ Section locales_helpers.
     intros H. inversion H as [? ? e1 ? e2 ? efs t1 t2|]; simplify_eq; simpl.
     - replace (t1 ++ e2 :: t2 ++ efs) with ((t1 ++ e2 :: t2) ++ efs); last by list_simplifier.
       replace (length (t1 ++ e1 :: t2)) with (length (t1 ++ e2 :: t2)); last first.
-      { rewrite !app_length //=. }
+      { rewrite !length_app //=. }
       rewrite take_app_length. apply locales_equiv_middle.
       eapply locale_step_preserve =>//.
     - rewrite take_ge =>//. apply locales_equiv_refl.
@@ -539,7 +539,7 @@ Section locales_utils.
     intros Hprefix1 Hprefix2 Hequiv.
     apply locales_equiv_from_impl.
     { apply Forall2_length in Hequiv. rewrite !prefixes_from_length in Hequiv.
-      by rewrite !skipn_length Hequiv. }
+      by rewrite !length_skipn Hequiv. }
     apply locales_equiv_prefix_from_drop in Hprefix1.
     apply locales_equiv_prefix_from_drop in Hprefix2.
     apply locales_equiv_from_comm in Hprefix1.
@@ -803,7 +803,7 @@ Section adequacy_helper_lemmas.
       + simpl; f_equal; first erewrite locale_equiv=> //.
         specialize (IHt (t0 ++ [a]) (t0' ++ [a]) _ _ Hlen1).
         simpl in IHt. rewrite !drop_0 in IHt. apply IHt.
-        * rewrite !app_length. lia.
+        * rewrite !length_app. lia.
         * apply locales_equiv_snoc =>//. list_simplifier. apply locale_equiv =>//.
       + simpl. apply IHt =>//. simpl in Hlen1. lia.
   Qed.
@@ -845,7 +845,7 @@ Section adequacy_helper_lemmas.
     (* TODO: factorize the two halves *)
     rewrite big_sepL2_alt; iSplit.
     - iIntros "H". iSplit.
-      { rewrite drop_app_length // map_length !prefixes_from_length //. }
+      { rewrite drop_app_length // length_map !prefixes_from_length //. }
       iInduction efs as [|ef efs] "IH" forall (t); first done.
       rewrite /= !drop_app_length //=.
       iDestruct "H" as "[H1 H]". rewrite (right_id [] (++)). iFrame.
@@ -1196,7 +1196,7 @@ Proof.
     apply locale_step_equiv in Hstep.
     rewrite (locales_equiv_prefix_drop_alt _ tp); [|done].
     rewrite -drop_app_le; last first.
-    { rewrite fmap_length. rewrite prefixes_from_length. lia. }
+    { rewrite length_fmap. rewrite prefixes_from_length. lia. }
     rewrite (locales_equiv_prefix_drop_alt es c'.1);
       [|by eapply locales_equiv_prefix_trans].
     f_equiv.
@@ -1495,6 +1495,36 @@ Proof.
   iModIntro; iIntros "[$ ?]"; done.
 Qed.
 
+Definition cur_posts `{irisG Λ M Σ} (tp: list (expr Λ)) e0 (Φ0: val Λ → iProp Σ): iProp Σ :=
+  posts_of tp (Φ0 :: ((λ '(tnew, e), fork_post (locale_of tnew e)) <$>
+                        prefixes_from [e0] (drop 1 tp))).
+
+
+Definition rel_always_holds0 `{irisG Λ M Σ}
+  (ξ: execution_trace Λ → auxiliary_trace M → Prop)
+  (s: stuckness)
+  (stateI: execution_trace Λ → auxiliary_trace M → iProp Σ)
+  (Φ0: val Λ → iProp Σ) 
+  e1 σ1 δ1: iProp Σ
+  :=
+  ∀ (ex : execution_trace Λ) (atr : auxiliary_trace M)
+    (c : cfg Λ),
+    ⌜valid_system_trace ex atr⌝ -∗
+    ⌜trace_starts_in ex ([e1], σ1)⌝ -∗
+    ⌜trace_starts_in atr δ1⌝ -∗
+    ⌜trace_ends_in ex c⌝ -∗
+    ⌜∀ (ex' : finite_trace (cfg Λ) (olocale Λ))
+       (atr' : auxiliary_trace M) (oζ : olocale Λ)
+       (ℓ: mlabel M),
+    trace_contract ex oζ ex' → trace_contract atr ℓ atr' → ξ ex' atr'⌝ -∗
+    ⌜∀ e2 : expr Λ, s = NotStuck → e2 ∈ c.1 → not_stuck e2 c.2⌝ -∗
+    ⌜locales_equiv [e1] (take (length [e1]) c.1)⌝ -∗
+    stateI ex atr -∗
+    (* posts_of c.1 (Φ0 :: ((λ '(tnew, e), fork_post (locale_of tnew e)) <$> *)
+    (*                         prefixes_from [e1] (drop (length [e1]) c.1))) *)
+    cur_posts c.1 e1 Φ0
+    ={⊤,∅}=∗ ⌜ξ ex atr⌝.
+
 Theorem wp_strong_adequacy Λ M Σ `{!invGpreS Σ}
         (s: stuckness)
         (ξ : execution_trace Λ → auxiliary_trace M → Prop)
@@ -1509,7 +1539,8 @@ Theorem wp_strong_adequacy Λ M Σ `{!invGpreS Σ}
        config_wp ∗
        stateI (trace_singleton ([e1], σ1)) (trace_singleton δ1) ∗
        WP e1 @ s; locale_of [] e1; ⊤ {{ Φ }} ∗
-       rel_always_holds s [Φ] ξ ([e1], σ1) δ1) →
+       (* rel_always_holds s [Φ] ξ ([e1], σ1) δ1) → *)
+       rel_always_holds0 ξ s stateI Φ e1 σ1 δ1) ->
   continued_simulation ξ (trace_singleton ([e1], σ1)) (trace_singleton δ1).
 Proof.
   intros Hsc Hwptp.
@@ -1610,7 +1641,7 @@ Proof.
   specialize (Hψ (t2, σ2)) as [Hsafe Hstuck]; [done|].
   split; [|done].
   intros i v Hlen1 Hlen2 Ht2.
-  rewrite fmap_length in Hlen2.
+  rewrite length_fmap in Hlen2.
   specialize (Hsafe i v Hlen2 Ht2).
   clear Himpl Ht2 Hsm Hexstr. revert i es Hlen1 Hlen2 Hsafe.
   induction φs as [|φ φs Hφs]; intros i es Hlen1 Hlen2 Hsafe; [done|].
diff --git a/trillium/program_logic/weakestpre.v b/trillium/program_logic/weakestpre.v
index 3d7623e..bbe1b41 100644
--- a/trillium/program_logic/weakestpre.v
+++ b/trillium/program_logic/weakestpre.v
@@ -5,7 +5,7 @@ From trillium.bi Require Export weakestpre.
 From iris.prelude Require Import options.
 
 Class irisG (Λ : language) (M : Model) (Σ : gFunctors) := IrisG {
-  iris_invGS :> invGS_gen HasNoLc Σ;
+  iris_invGS :: invGS_gen HasNoLc Σ;
 
   (** The state interpretation is an invariant that should hold in between each
   step of reduction. Here [Λstate] is the global state, [list Λobservation] are
diff --git a/trillium/traces/infinite_trace.v b/trillium/traces/infinite_trace.v
index 6b426a1..9ff7034 100644
--- a/trillium/traces/infinite_trace.v
+++ b/trillium/traces/infinite_trace.v
@@ -1,4 +1,4 @@
-From Coq.ssr Require Import ssreflect.
+From Stdlib.ssr Require Import ssreflect.
 From stdpp Require Import prelude.
 
 Set Default Proof Using "Type".
@@ -12,7 +12,7 @@ CoInductive inflist (A : Type) : Type :=
 Bind Scope inflist_scope with inflist.
 
 Arguments infnil {_}, _.
-Arguments infcons {_} _ _%inflist.
+Arguments infcons {_} _ %_inflist.
 
 Module InfListNotations.
 Notation "[ ]" := infnil (format "[ ]") : inflist_scope.
@@ -131,7 +131,7 @@ Global Instance ilist_fmap : FMap inflist :=
 Section inflist_fmap.
   Context {A B} (f : A → B).
 
-  Lemma inflist_fmap_length (il : inflist A) : inflist_same_length il (f <$> il).
+  Lemma inflist_flength_map (il : inflist A) : inflist_same_length il (f <$> il).
   Proof.
     intros n; revert il; induction n; intros il.
     - rewrite (inflist_unfold_fold (f <$> il)).
diff --git a/trillium/traces/trace.v b/trillium/traces/trace.v
index 3b677e7..6e43b26 100644
--- a/trillium/traces/trace.v
+++ b/trillium/traces/trace.v
@@ -274,7 +274,7 @@ Section finite_trace.
     ((oζ, trace_last ft) :: l) !! length l = Some (oζ', trace_last (ft +trl+ l)).
   Proof.
     induction l as [|[a ?] l IHl] using rev_ind; first by eexists.
-    rewrite app_length /= trace_append_list_snoc /=.
+    rewrite length_app /= trace_append_list_snoc /=.
     rewrite (lookup_app_r (_ :: _)) /=; last by simpl; lia.
     replace (length l + 1 - S (length l)) with 0 by lia.
     eexists. done.
@@ -284,9 +284,9 @@ Section finite_trace.
     ((trace_last ft) :: map snd l) !! length l = Some (trace_last (ft +trl+ l)).
   Proof.
     induction l as [|[a ?] l IHl] using rev_ind; first by eexists.
-    rewrite app_length /= trace_append_list_snoc /=.
-    rewrite map_app (lookup_app_r (_ :: _)) /=; last by rewrite map_length /=; lia.
-    rewrite map_length.
+    rewrite length_app /= trace_append_list_snoc /=.
+    rewrite map_app (lookup_app_r (_ :: _)) /=; last by rewrite length_map /=; lia.
+    rewrite length_map.
     replace (length l + 1 - S (length l)) with 0 by lia.
     done.
   Qed.
diff --git a/trillium/traces/trace_properties.v b/trillium/traces/trace_properties.v
index a8e1668..dfa1455 100644
--- a/trillium/traces/trace_properties.v
+++ b/trillium/traces/trace_properties.v
@@ -1,5 +1,5 @@
 From stdpp Require Export base prelude finite.
-From Coq.ssr Require Import ssreflect.
+From Stdlib.ssr Require Import ssreflect.
 From trillium.traces Require Import infinite_trace trace.
 
 Import InfListNotations.