diff --git a/.gitignore b/.gitignore
index affc2b4e..02dbca5c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -32,7 +32,7 @@ deps.dot
 .coqdeps.d
 Makefile.coq
 Makefile.coq.conf
-/_CoqProject
+# /_CoqProject
 examples/_CoqProject
 tutorial/_CoqProject
 _CoqPath
@@ -52,3 +52,9 @@ tutorial/imp_test.mli
 *.native
 
 *.install
+.mcp.json
+rocq_mcp_cache_8675_.v
+rocq_mcp_cache_85046_.v
+.Makefile.d
+Makefile.conf
+Makefile
diff --git a/DEV.md b/DEV.md
index 94bef7d9..034692cf 100644
--- a/DEV.md
+++ b/DEV.md
@@ -9,7 +9,7 @@ and also to generate documentation.
 Install dependencies with `opam`.
 
 ```
-opam install coq-paco coq-ext-lib dune
+opam install rocq-coinduction coq-ext-lib dune
 ```
 
 Then `dune build` will compile everything: library, tutorial (toy compiler from
@@ -49,7 +49,7 @@ dune runtest
 This uses the same dependencies, minus `dune`.
 
 ```
-opam install coq-paco coq-ext-lib
+opam install rocq-coinduction coq-ext-lib
 ```
 
 Build everything with `make all`.
@@ -163,7 +163,7 @@ for testing.
 - `Eq`: Equational theory of interaction trees.
 
     + `Shallow`: One-step unfolding of cofixpoints.
-    + `Eq`: Strong bisimulation.
+    + `Eqit`: Strong bisimulation.
     + `UpToTaus`: Weak bisimulation.
     + `SimUpToTaus`: Weak simulation.
     + `EqAxiom`: Axiom that strong bisimulation is propositional equality.
diff --git a/Makefile b/Makefile
index 0b8899c7..c5f54563 100644
--- a/Makefile
+++ b/Makefile
@@ -1,69 +1,961 @@
-.PHONY: clean all coq test tests examples tutorial hoare_example secure_example install uninstall depgraph for-dune
+##########################################################################
+##         #      The Rocq Prover / The Rocq Development Team           ##
+##  v      #         Copyright INRIA, CNRS and contributors             ##
+## <O___,, # (see version control and CREDITS file for authors & dates) ##
+##   \VV/  ###############################################################
+##    //   #    This file is distributed under the terms of the         ##
+##         #     GNU Lesser General Public License Version 2.1          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+## GNUMakefile for Rocq 9.1.1
 
-COQPATHFILE=$(wildcard _CoqPath)
+# For debugging purposes (must stay here, don't move below)
+INITIAL_VARS := $(.VARIABLES)
+# To implement recursion we save the name of the main Makefile
+SELF := $(lastword $(MAKEFILE_LIST))
+PARENT := $(firstword $(MAKEFILE_LIST))
 
-build: coq
+# This file is generated by coq_makefile and contains many variable
+# definitions, like the list of .v files or the path to Rocq
+include Makefile.conf
 
-include common.mk
+# Put in place old names
+VFILES            := $(COQMF_VFILES)
+MLIFILES          := $(COQMF_MLIFILES)
+MLFILES           := $(COQMF_MLFILES)
+MLGFILES          := $(COQMF_MLGFILES)
+MLPACKFILES       := $(COQMF_MLPACKFILES)
+MLLIBFILES        := $(COQMF_MLLIBFILES)
+METAFILE          := $(COQMF_METAFILE)
+CMDLINE_VFILES    := $(COQMF_CMDLINE_VFILES)
+INSTALLCOQDOCROOT := $(COQMF_INSTALLCOQDOCROOT)
+OTHERFLAGS        := $(COQMF_OTHERFLAGS)
+COQCORE_SRC_SUBDIRS := $(COQMF_COQ_SRC_SUBDIRS)
+OCAMLLIBS         := $(COQMF_OCAMLLIBS)
+SRC_SUBDIRS       := $(COQMF_SRC_SUBDIRS)
+COQLIBS           := $(COQMF_COQLIBS)
+COQLIBS_NOML      := $(COQMF_COQLIBS_NOML)
+CMDLINE_COQLIBS   := $(COQMF_CMDLINE_COQLIBS)
+COQLIB            := $(COQMF_COQLIB)
+COQCORELIB        := $(COQMF_COQCORELIB)
+DOCDIR            := $(COQMF_DOCDIR)
+OCAMLFIND         := $(COQMF_OCAMLFIND)
+CAMLFLAGS         := $(COQMF_CAMLFLAGS)
+HASNATDYNLINK     := $(COQMF_HASNATDYNLINK)
+OCAMLWARN         := $(COQMF_WARN)
+
+Makefile.conf: _CoqProject
+	coq_makefile -f _CoqProject -o Makefile
+
+# This file can be created by the user to hook into double colon rules or
+# add any other Makefile code they may need
+-include Makefile.local
+
+# Parameters ##################################################################
+#
+# Parameters are make variable assignments.
+# They can be passed to (each call to) make on the command line.
+# They can also be put in Makefile.local once and for all.
+# For retro-compatibility reasons they can be put in the _CoqProject, but this
+# practice is discouraged since _CoqProject better not contain make specific
+# code (be nice to user interfaces).
+
+# Set KEEP_ERROR to have make keep files produced by failing rules.
+# By default, KEEP_ERROR is empty. So for instance if rocq c creates a .vo but
+# then fails to native compile, the .vo will be deleted.
+# May confuse make so use only for debugging.
+KEEP_ERROR?=
+ifeq (,$(KEEP_ERROR))
+.DELETE_ON_ERROR:
+endif
+
+# Print shell commands (set to non empty)
+VERBOSE ?=
+
+# Time the Rocq process (set to non empty), and how (see default value)
+TIMED?=
+TIMECMD?=
+# Use command time on linux, gtime on Mac OS
+TIMEFMT?="$(if $(findstring undefined, $(flavor 1)),$@,$(1)) (real: %e, user: %U, sys: %S, mem: %M ko)"
+ifeq (0,$(shell command time -f "" true >/dev/null 2>/dev/null; echo $$?))
+STDTIME?=command time -f $(TIMEFMT)
+else
+ifeq (0,$(shell gtime -f "" true >/dev/null 2>/dev/null; echo $$?))
+STDTIME?=gtime -f $(TIMEFMT)
+else
+STDTIME?=command time
+endif
+endif
+
+COQBIN?=
+ifneq (,$(COQBIN))
+# add an ending /
+COQBIN:=$(COQBIN)/
+endif
+
+# Coq binaries
+ROCQ     ?= "$(COQBIN)rocq"
+COQC     ?= "$(COQBIN)rocq" c
+COQTOP   ?= "$(COQBIN)rocq" repl
+COQCHK   ?= "$(COQBIN)rocqchk"
+COQNATIVE ?= "$(COQBIN)rocq" native-precompile
+COQDEP   ?= "$(COQBIN)rocq" dep
+COQDOC   ?= "$(COQBIN)rocq" doc
+COQPP    ?= "$(COQBIN)rocq" pp-mlg
+COQMKFILE ?= "$(COQBIN)rocq" makefile
+OCAMLLIBDEP ?= "$(COQBIN)ocamllibdep"
+
+# Timing scripts
+COQMAKE_ONE_TIME_FILE ?= "$(COQCORELIB)/tools/make-one-time-file.py"
+COQMAKE_BOTH_TIME_FILES ?= "$(COQCORELIB)/tools/make-both-time-files.py"
+COQMAKE_BOTH_SINGLE_TIMING_FILES ?= "$(COQCORELIB)/tools/make-both-single-timing-files.py"
+BEFORE ?=
+AFTER ?=
+
+# OCaml binaries
+CAMLC       ?= "$(OCAMLFIND)" ocamlc   -c
+CAMLOPTC    ?= "$(OCAMLFIND)" opt      -c
+CAMLLINK    ?= "$(OCAMLFIND)" ocamlc   -linkall
+CAMLOPTLINK ?= "$(OCAMLFIND)" opt      -linkall
+CAMLDOC     ?= "$(OCAMLFIND)" ocamldoc
+CAMLDEP     ?= "$(OCAMLFIND)" ocamldep -slash -ml-synonym .mlpack
+
+# DESTDIR is prepended to all installation paths
+DESTDIR ?=
+
+# Debug builds, typically -g to OCaml, -debug to Rocq.
+CAMLDEBUG ?=
+COQDEBUG ?=
+
+# Extra packages to be linked in (as in findlib -package)
+CAMLPKGS ?=
+FINDLIBPKGS = -package rocq-runtime.plugins.ltac $(CAMLPKGS)
+
+# Option for making timing files
+TIMING?=
+# Option for changing sorting of timing output file
+TIMING_SORT_BY ?= auto
+# Option for changing the fuzz parameter on the output file
+TIMING_FUZZ ?= 0
+# Option for changing whether to use real or user time for timing tables
+TIMING_REAL?=
+# Option for including the memory column(s)
+TIMING_INCLUDE_MEM?=
+# Option for sorting by the memory column
+TIMING_SORT_BY_MEM?=
+# Output file names for timed builds
+TIME_OF_BUILD_FILE               ?= time-of-build.log
+TIME_OF_BUILD_BEFORE_FILE        ?= time-of-build-before.log
+TIME_OF_BUILD_AFTER_FILE         ?= time-of-build-after.log
+TIME_OF_PRETTY_BUILD_FILE        ?= time-of-build-pretty.log
+TIME_OF_PRETTY_BOTH_BUILD_FILE   ?= time-of-build-both.log
+TIME_OF_PRETTY_BUILD_EXTRA_FILES ?= - # also output to the command line
+
+TGTS ?=
+
+# Retro compatibility (DESTDIR is standard on Unix, DSTROOT is not)
+ifdef DSTROOT
+DESTDIR := $(DSTROOT)
+endif
+
+# Substitution of the path by appending $(DESTDIR) if needed.
+# The variable $(COQMF_WINDRIVE) can be needed for Cygwin environments.
+windrive_path = $(if $(COQMF_WINDRIVE),$(subst $(COQMF_WINDRIVE),/,$(1)),$(1))
+destination_path = $(if $(DESTDIR),$(DESTDIR)/$(call windrive_path,$(1)),$(1))
+
+# Installation paths of libraries and documentation.
+COQLIBINSTALL ?= $(call destination_path,$(COQLIB)/user-contrib)
+COQDOCINSTALL ?= $(call destination_path,$(DOCDIR)/coq/user-contrib)
+COQPLUGININSTALL ?= $(call destination_path,$(COQCORELIB)/..)
+COQTOPINSTALL ?= $(call destination_path,$(COQLIB)/toploop) # FIXME: Unused variable?
+
+# findlib files installation
+FINDLIBPREINST= mkdir -p "$(COQPLUGININSTALL)/"
+FINDLIBDESTDIR= -destdir "$(COQPLUGININSTALL)/"
+
+# we need to move out of sight $(METAFILE) otherwise findlib thinks the
+# package is already installed
+findlib_install = \
+	$(HIDE)if [ "$(METAFILE)" ]; then \
+	  $(FINDLIBPREINST) && \
+	  mv "$(METAFILE)" "$(METAFILE).skip" ; \
+	  "$(OCAMLFIND)" install $(2) $(FINDLIBDESTDIR) $(FINDLIBPACKAGE) $(1); \
+	  rc=$$?; \
+	  mv "$(METAFILE).skip" "$(METAFILE)"; \
+	  exit $$rc; \
+	fi
+findlib_remove = \
+	$(HIDE)if [ ! -z "$(METAFILE)" ]; then\
+	  "$(OCAMLFIND)" remove $(FINDLIBDESTDIR) $(FINDLIBPACKAGE); \
+	fi
+
+
+########## End of parameters ##################################################
+# What follows may be relevant to you only if you need to
+# extend this Makefile.  If so, look for 'Extension point' here and
+# put in Makefile.local double colon rules accordingly.
+# E.g. to perform some work after the all target completes you can write
+#
+# post-all::
+# 	echo "All done!"
+#
+# in Makefile.local
+#
+###############################################################################
+
+
+
+
+# Flags #######################################################################
+#
+# We define a bunch of variables combining the parameters.
+# To add additional flags to coq, coqchk or coqdoc, set the
+# {COQ,COQCHK,COQDOC}EXTRAFLAGS variable to whatever you want to add.
+# To overwrite the default choice and set your own flags entirely, set the
+# {COQ,COQCHK,COQDOC}FLAGS variable.
+
+SHOW := $(if $(VERBOSE),@true "",@echo "")
+HIDE := $(if $(VERBOSE),,@)
+
+TIMER=$(if $(TIMED), $(STDTIME), $(TIMECMD))
+
+OPT?=
+
+# The DYNLIB variable is used by "coqdep -dyndep var" in .v.d
+ifeq '$(OPT)' '-byte'
+USEBYTE:=true
+DYNLIB:=.cma
+else
+USEBYTE:=
+DYNLIB:=.cmxs
+endif
+
+# these variables are meant to be overridden if you want to add *extra* flags
+COQEXTRAFLAGS?=
+COQCHKEXTRAFLAGS?=
+COQDOCEXTRAFLAGS?=
+
+# Find the last argument of the form "-native-compiler FLAG"
+COQUSERNATIVEFLAG:=$(strip \
+$(subst -native-compiler-,,\
+$(lastword \
+$(filter -native-compiler-%,\
+$(subst -native-compiler ,-native-compiler-,\
+$(strip $(COQEXTRAFLAGS)))))))
+
+COQFILTEREDEXTRAFLAGS:=$(strip \
+$(filter-out -native-compiler-%,\
+$(subst -native-compiler ,-native-compiler-,\
+$(strip $(COQEXTRAFLAGS)))))
+
+COQACTUALNATIVEFLAG:=$(lastword $(COQMF_COQ_NATIVE_COMPILER_DEFAULT) $(COQMF_COQPROJECTNATIVEFLAG) $(COQUSERNATIVEFLAG))
+
+ifeq '$(COQACTUALNATIVEFLAG)' 'yes'
+  COQNATIVEFLAG="-w" "-deprecated-native-compiler-option" "-native-compiler" "ondemand"
+  COQDONATIVE="yes"
+else
+ifeq '$(COQACTUALNATIVEFLAG)' 'ondemand'
+  COQNATIVEFLAG="-w" "-deprecated-native-compiler-option" "-native-compiler" "ondemand"
+  COQDONATIVE="no"
+else
+  COQNATIVEFLAG="-w" "-deprecated-native-compiler-option" "-native-compiler" "no"
+  COQDONATIVE="no"
+endif
+endif
+
+# these flags do NOT contain the libraries, to make them easier to overwrite
+COQFLAGS?=-q $(OTHERFLAGS) $(COQFILTEREDEXTRAFLAGS) $(COQNATIVEFLAG)
+COQCHKFLAGS?=-silent -o $(COQCHKEXTRAFLAGS)
+COQDOCFLAGS?=-interpolate -utf8 $(COQDOCEXTRAFLAGS)
+
+COQDOCLIBS?=$(COQLIBS_NOML)
+
+# The version of Coq being run and the version of rocq makefile that
+# generated this makefile
+# NB --print-version is not in the rocq shim
+COQ_VERSION:=$(shell $(ROCQ) c --print-version | cut -d " " -f 1)
+COQMAKEFILE_VERSION:=9.1.1
+
+# COQ_SRC_SUBDIRS is for user-overriding, usually to add
+# `user-contrib/Foo` to the includes, we keep COQCORE_SRC_SUBDIRS for
+# Coq's own core libraries, which should be replaced by ocamlfind
+# options at some point.
+COQ_SRC_SUBDIRS?=
+COQSRCLIBS?= $(foreach d,$(COQ_SRC_SUBDIRS), -I "$(COQLIB)/$(d)")
+
+CAMLFLAGS+=$(OCAMLLIBS) $(COQSRCLIBS)
+# ocamldoc fails with unknown argument otherwise
+CAMLDOCFLAGS:=$(filter-out -annot, $(filter-out -bin-annot, $(CAMLFLAGS)))
+CAMLFLAGS+=$(OCAMLWARN)
+
+ifneq (,$(TIMING))
+  ifeq (after,$(TIMING))
+    TIMING_EXT=after-timing
+  else
+    ifeq (before,$(TIMING))
+      TIMING_EXT=before-timing
+    else
+      TIMING_EXT=timing
+    endif
+  endif
+  TIMING_ARG=-time-file $<.$(TIMING_EXT)
+else
+  TIMING_ARG=
+endif
+
+ifneq (,$(PROFILING))
+  PROFILE_ARG=-profile $@.prof.json
+  PROFILE_ZIP=gzip -f $@.prof.json
+else
+  PROFILE_ARG=
+  PROFILE_ZIP=true
+endif
+
+# Files #######################################################################
+#
+# We here define a bunch of variables about the files being part of the
+# Rocq project in order to ease the writing of build target and build rules
+
+VDFILE := .Makefile.d
+
+ALLSRCFILES := \
+	$(MLGFILES) \
+	$(MLFILES) \
+	$(MLPACKFILES) \
+	$(MLLIBFILES) \
+	$(MLIFILES)
+
+# helpers
+vo_to_obj = $(addsuffix .o,\
+  $(filter-out Warning: Error:,\
+  $(shell $(COQTOP) -q -noinit -batch -quiet -print-mod-uid $(1))))
+strip_dotslash = $(patsubst ./%,%,$(1))
+
+# without this we get undefined variables in the expansion for the
+# targets of the [deprecated,use-mllib-or-mlpack] rule
+with_undef = $(if $(filter-out undefined, $(origin $(1))),$($(1)))
+
+VO = vo
+VOS = vos
+
+VOFILES = $(VFILES:.v=.$(VO))
+GLOBFILES = $(VFILES:.v=.glob)
+HTMLFILES = $(VFILES:.v=.html)
+GHTMLFILES = $(VFILES:.v=.g.html)
+BEAUTYFILES = $(addsuffix .beautified,$(VFILES))
+TEXFILES = $(VFILES:.v=.tex)
+GTEXFILES = $(VFILES:.v=.g.tex)
+CMOFILES = \
+	$(MLGFILES:.mlg=.cmo) \
+	$(MLFILES:.ml=.cmo) \
+	$(MLPACKFILES:.mlpack=.cmo)
+CMXFILES = $(CMOFILES:.cmo=.cmx)
+OFILES = $(CMXFILES:.cmx=.o)
+CMAFILES = $(MLLIBFILES:.mllib=.cma) $(MLPACKFILES:.mlpack=.cma)
+CMXAFILES = $(CMAFILES:.cma=.cmxa)
+CMIFILES = \
+	$(CMOFILES:.cmo=.cmi) \
+	$(MLIFILES:.mli=.cmi)
+# the /if/ is because old _CoqProject did not list a .ml(pack|lib) but just
+# a .mlg file
+CMXSFILES = \
+	$(MLPACKFILES:.mlpack=.cmxs) \
+	$(CMXAFILES:.cmxa=.cmxs) \
+	$(if $(MLPACKFILES)$(CMXAFILES),,\
+		$(MLGFILES:.mlg=.cmxs) $(MLFILES:.ml=.cmxs))
+
+# files that are packed into a plugin (no extension)
+PACKEDFILES = \
+	$(call strip_dotslash, \
+	  $(foreach lib, \
+	    $(call strip_dotslash, \
+	       $(MLPACKFILES:.mlpack=_MLPACK_DEPENDENCIES)),$(call with_undef,$(lib))))
+# files that are archived into a .cma (mllib)
+LIBEDFILES = \
+	$(call strip_dotslash, \
+	  $(foreach lib, \
+	    $(call strip_dotslash, \
+	       $(MLLIBFILES:.mllib=_MLLIB_DEPENDENCIES)),$(call with_undef,$(lib))))
+CMIFILESTOINSTALL = $(filter-out $(addsuffix .cmi,$(PACKEDFILES)),$(CMIFILES))
+CMOFILESTOINSTALL = $(filter-out $(addsuffix .cmo,$(PACKEDFILES)),$(CMOFILES))
+OBJFILES = $(call vo_to_obj,$(VOFILES))
+ALLNATIVEFILES = \
+	$(OBJFILES:.o=.cmi) \
+	$(OBJFILES:.o=.cmx) \
+	$(OBJFILES:.o=.cmxs)
+FINDLIBPACKAGE=$(patsubst .%,%,$(suffix $(METAFILE)))
+
+# trick: wildcard filters out non-existing files, so that `install` doesn't show
+# warnings and `clean` doesn't pass to rm a list of files that is too long for
+# the shell.
+NATIVEFILES = $(wildcard $(ALLNATIVEFILES))
+FILESTOINSTALL = \
+	$(VOFILES) \
+	$(VFILES) \
+	$(GLOBFILES) \
+	$(NATIVEFILES)
+FINDLIBFILESTOINSTALL = \
+	$(CMIFILESTOINSTALL)
+ifeq '$(HASNATDYNLINK)' 'true'
+DO_NATDYNLINK = yes
+FINDLIBFILESTOINSTALL += $(CMXSFILES) $(CMXAFILES) $(CMOFILESTOINSTALL:.cmo=.cmx)
+else
+DO_NATDYNLINK =
+endif
+
+ALLDFILES = $(addsuffix .d,$(ALLSRCFILES)) $(VDFILE)
+
+# Compilation targets #########################################################
 
 all:
-	# Build the library before tests
-	$(MAKE) coq
-	$(MAKE) test
-	$(MAKE) hoare_example
-	$(MAKE) secure_example
-
-install: Makefile.coq coq
-	$(MAKE) -f $< $@
-
-uninstall: Makefile.coq
-	$(MAKE) -f $< $@
-
-test: examples tests
-
-tests:
-	$(MAKE) -C tests
-	$(MAKE) -C tutorial test
-
-examples:
-	$(MAKE) -C examples
-
-tutorial:
-	$(MAKE) -C tutorial
-
-hoare_example:
-	$(MAKE) -C hoare_example
-
-secure_example:
-	$(MAKE) -C secure_example
-
-clean: clean-coq
-	$(RM) _CoqProject
-	$(MAKE) -C tests clean
-	$(MAKE) -C examples clean
-	$(MAKE) -C tutorial clean
-	$(MAKE) -C hoare_example clean
-	$(MAKE) -C secure_example clean
-
-_CoqProject: $(COQPATHFILE) _CoqProject.itree _CoqProject.extra Makefile
-	@ echo "# Generating _CoqProject"
-	@ rm -f _CoqProject
-	@ echo "# THIS IS AN AUTOMATICALLY GENERATED FILE" >> _CoqProject
-	@ echo "# PLEASE EDIT _CoqConfig INSTEAD" >> _CoqProject
-	@ echo >> _CoqProject
-ifneq ("$(COQPATHFILE)","")
-	@ echo "# including: _CoqPath"
-	@ cat _CoqPath >> _CoqProject
-	@ echo >> _CoqProject
-endif
-	@ echo "# including: _CoqConfig"
-	@ cat _CoqProject.itree _CoqProject.extra >> _CoqProject
-
-COQDEP=coqdep
-DEPS_DOT=deps.dot
-DEPS_OUT=deps.jpg
-
-depgraph:
-	$(COQDEP) -dumpgraph $(DEPS_DOT) $(shell cat _CoqConfig) > /dev/null 2>&1
-	sed 's%\("theories/\([^"]*\)/\([^"/]*\)"\[label="\)%\1\2/\\n%' -i $(DEPS_DOT)
-	dot $(DEPS_DOT) -Tjpg -o$(DEPS_OUT)
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" pre-all
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" real-all
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" post-all
+.PHONY: all
+
+all.timing.diff:
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" pre-all
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" real-all.timing.diff TIME_OF_PRETTY_BUILD_EXTRA_FILES=""
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" post-all
+.PHONY: all.timing.diff
+
+ifeq (0,$(TIMING_REAL))
+TIMING_REAL_ARG :=
+TIMING_USER_ARG := --user
+else
+ifeq (1,$(TIMING_REAL))
+TIMING_REAL_ARG := --real
+TIMING_USER_ARG :=
+else
+TIMING_REAL_ARG :=
+TIMING_USER_ARG :=
+endif
+endif
+
+ifeq (0,$(TIMING_INCLUDE_MEM))
+TIMING_INCLUDE_MEM_ARG := --no-include-mem
+else
+TIMING_INCLUDE_MEM_ARG :=
+endif
+
+ifeq (1,$(TIMING_SORT_BY_MEM))
+TIMING_SORT_BY_MEM_ARG := --sort-by-mem
+else
+TIMING_SORT_BY_MEM_ARG :=
+endif
+
+make-pretty-timed-before:: TIME_OF_BUILD_FILE=$(TIME_OF_BUILD_BEFORE_FILE)
+make-pretty-timed-after:: TIME_OF_BUILD_FILE=$(TIME_OF_BUILD_AFTER_FILE)
+make-pretty-timed make-pretty-timed-before make-pretty-timed-after::
+	$(HIDE)rm -f pretty-timed-success.ok
+	$(HIDE)($(MAKE) --no-print-directory -f "$(PARENT)" $(TGTS) TIMED=1 2>&1 && touch pretty-timed-success.ok) | tee -a $(TIME_OF_BUILD_FILE)
+	$(HIDE)rm pretty-timed-success.ok # must not be -f; must fail if the touch failed
+print-pretty-timed::
+	$(HIDE)$(COQMAKE_ONE_TIME_FILE) $(TIMING_INCLUDE_MEM_ARG) $(TIMING_SORT_BY_MEM_ARG) $(TIMING_REAL_ARG) $(TIME_OF_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES)
+print-pretty-timed-diff::
+	$(HIDE)$(COQMAKE_BOTH_TIME_FILES) --sort-by=$(TIMING_SORT_BY) $(TIMING_INCLUDE_MEM_ARG) $(TIMING_SORT_BY_MEM_ARG) $(TIMING_REAL_ARG) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES)
+ifeq (,$(BEFORE))
+print-pretty-single-time-diff::
+	@echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff AFTER=path/to/file.v.after-timing BEFORE=path/to/file.v.before-timing'
+	$(HIDE)false
+else
+ifeq (,$(AFTER))
+print-pretty-single-time-diff::
+	@echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff AFTER=path/to/file.v.after-timing BEFORE=path/to/file.v.before-timing'
+	$(HIDE)false
+else
+print-pretty-single-time-diff::
+	$(HIDE)$(COQMAKE_BOTH_SINGLE_TIMING_FILES) --fuzz=$(TIMING_FUZZ) --sort-by=$(TIMING_SORT_BY) $(TIMING_USER_ARG) $(AFTER) $(BEFORE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES)
+endif
+endif
+pretty-timed:
+	$(HIDE)$(MAKE) --no-print-directory -f "$(PARENT)" make-pretty-timed
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" print-pretty-timed
+.PHONY: pretty-timed make-pretty-timed make-pretty-timed-before make-pretty-timed-after print-pretty-timed print-pretty-timed-diff print-pretty-single-time-diff
+
+# Extension points for actions to be performed before/after the all target
+pre-all::
+	@# Extension point
+	$(HIDE)if [ "$(COQMAKEFILE_VERSION)" != "$(COQ_VERSION)" ]; then\
+	  echo "W: This Makefile was generated by Rocq/Coq $(COQMAKEFILE_VERSION)";\
+	  echo "W: while the current Rocq version is $(COQ_VERSION)";\
+	fi
+.PHONY: pre-all
+
+post-all::
+	@# Extension point
+.PHONY: post-all
+
+real-all: $(VOFILES) $(if $(USEBYTE),bytefiles,optfiles)
+.PHONY: real-all
+
+real-all.timing.diff: $(VOFILES:.vo=.v.timing.diff)
+.PHONY: real-all.timing.diff
+
+bytefiles: $(CMOFILES) $(CMAFILES)
+.PHONY: bytefiles
+
+optfiles: $(if $(DO_NATDYNLINK),$(CMXSFILES))
+.PHONY: optfiles
+
+vos: $(VOFILES:%.vo=%.vos)
+.PHONY: vos
+
+vok: $(VOFILES:%.vo=%.vok)
+.PHONY: vok
+
+validate: $(VOFILES)
+	$(TIMER) $(COQCHK) $(COQCHKFLAGS) $(COQLIBS_NOML) $(PROFILE_ARG) $^
+	$(HIDE)$(PROFILE_ZIP)
+.PHONY: validate
+
+only: $(TGTS)
+.PHONY: only
+
+# Documentation targets #######################################################
+
+html: $(GLOBFILES) $(VFILES)
+	$(SHOW)'COQDOC -d html $(GAL)'
+	$(HIDE)mkdir -p html
+	$(HIDE)$(COQDOC) \
+		-toc $(COQDOCFLAGS) -html $(GAL) $(COQDOCLIBS) -d html $(VFILES)
+
+mlihtml: $(MLIFILES:.mli=.cmi)
+	$(SHOW)'CAMLDOC -d $@'
+	$(HIDE)mkdir $@ || rm -rf $@/*
+	$(HIDE)$(CAMLDOC) -html \
+		-d $@ -m A $(CAMLDEBUG) $(CAMLDOCFLAGS) $(MLIFILES) $(FINDLIBPKGS)
+
+all-mli.tex: $(MLIFILES:.mli=.cmi)
+	$(SHOW)'CAMLDOC -latex $@'
+	$(HIDE)$(CAMLDOC) -latex \
+		-o $@ -m A $(CAMLDEBUG) $(CAMLDOCFLAGS) $(MLIFILES) $(FINDLIBPKGS)
+
+all.ps: $(VFILES)
+	$(SHOW)'COQDOC -ps $(GAL)'
+	$(HIDE)$(COQDOC) \
+		-toc $(COQDOCFLAGS) -ps $(GAL) $(COQDOCLIBS) \
+		-o $@ `$(COQDEP) -sort $(VFILES)`
+
+all.pdf: $(VFILES)
+	$(SHOW)'COQDOC -pdf $(GAL)'
+	$(HIDE)$(COQDOC) \
+		-toc $(COQDOCFLAGS) -pdf $(GAL) $(COQDOCLIBS) \
+		-o $@ `$(COQDEP) -sort $(VFILES)`
+
+# FIXME: not quite right, since the output name is different
+gallinahtml: GAL=-g
+gallinahtml: html
+
+all-gal.ps: GAL=-g
+all-gal.ps: all.ps
+
+all-gal.pdf: GAL=-g
+all-gal.pdf: all.pdf
+
+# ?
+beautify: $(BEAUTYFILES)
+	for file in $^; do mv $${file%.beautified} $${file%beautified}old && mv $${file} $${file%.beautified}; done
+	@echo 'Do not do "make clean" until you are sure that everything went well!'
+	@echo 'If there were a problem, execute "for file in $$(find . -name \*.v.old -print); do mv $${file} $${file%.old}; done" in your shell/'
+.PHONY: beautify
+
+# Installation targets ########################################################
+#
+# There rules can be extended in Makefile.local
+# Extensions can't assume when they run.
+
+# We use $(file) to avoid generating a very long command string to pass to the shell
+# (cf https://coq.zulipchat.com/#narrow/stream/250632-Coq-Platform-devs-.26-users/topic/Strange.20command.20length.20limit.20on.20Linux)
+# However Apple ships old make which doesn't have $(file) so we need a fallback
+$(file >.hasfile,1)
+HASFILE:=$(shell if [ -e .hasfile ]; then echo 1; rm .hasfile; fi)
+
+MKFILESTOINSTALL= $(if $(HASFILE),$(file >.filestoinstall,$(FILESTOINSTALL)),\
+  $(shell rm -f .filestoinstall) \
+  $(foreach x,$(FILESTOINSTALL),$(shell printf '%s\n' "$x" >> .filestoinstall)))
+
+# findlib needs the package to not be installed, so we remove it before
+# installing it (see the call to findlib_remove)
+install: META
+	@$(MKFILESTOINSTALL)
+	$(HIDE)code=0; for f in $$(cat .filestoinstall); do\
+	 if ! [ -f "$$f" ]; then >&2 echo $$f does not exist; code=1; fi \
+	done; exit $$code
+	$(HIDE)for f in $$(cat .filestoinstall); do\
+	 df="`$(COQMKFILE) -destination-of "$$f" $(COQLIBS)`";\
+	 if [ "$$?" != "0" -o -z "$$df" ]; then\
+	   echo SKIP "$$f" since it has no logical path;\
+	 else\
+	   install -d "$(COQLIBINSTALL)/$$df" &&\
+	   install -m 0644 "$$f" "$(COQLIBINSTALL)/$$df" &&\
+	   echo INSTALL "$$f" "$(COQLIBINSTALL)/$$df";\
+	 fi;\
+	done
+	$(call findlib_remove)
+	$(call findlib_install, META $(FINDLIBFILESTOINSTALL))
+	$(HIDE)$(MAKE) install-extra -f "$(SELF)"
+	@rm -f .filestoinstall
+install-extra::
+	@# Extension point
+.PHONY: install install-extra
+
+META: $(METAFILE)
+	$(HIDE)if [ "$(METAFILE)" ]; then \
+		cat "$(METAFILE)" | grep -v 'directory.*=.*' > META; \
+	fi
+
+install-byte:
+	$(call findlib_install, $(CMAFILES) $(CMOFILESTOINSTALL), -add)
+
+install-doc:: html mlihtml
+	@# Extension point
+	$(HIDE)install -d "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html"
+	$(HIDE)for i in html/*; do \
+	 dest="$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/$$i";\
+	 install -m 0644 "$$i" "$$dest";\
+	 echo INSTALL "$$i" "$$dest";\
+	done
+	$(HIDE)install -d \
+		"$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml"
+	$(HIDE)for i in mlihtml/*; do \
+	 dest="$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/$$i";\
+	 install -m 0644 "$$i" "$$dest";\
+	 echo INSTALL "$$i" "$$dest";\
+	done
+.PHONY: install-doc
+
+uninstall::
+	@# Extension point
+	@$(MKFILESTOINSTALL)
+	$(call findlib_remove)
+	$(HIDE)for f in $$(cat .filestoinstall); do \
+	 df="`$(COQMKFILE) -destination-of "$$f" $(COQLIBS)`" &&\
+	 instf="$(COQLIBINSTALL)/$$df/`basename $$f`" &&\
+	 rm -f "$$instf" &&\
+	 echo RM "$$instf" ;\
+	done
+	$(HIDE)for f in $$(cat .filestoinstall); do \
+	 df="`$(COQMKFILE) -destination-of "$$f" $(COQLIBS)`" &&\
+	 echo RMDIR "$(COQLIBINSTALL)/$$df/" &&\
+	 (rmdir "$(COQLIBINSTALL)/$$df/" 2>/dev/null || true); \
+	done
+	@rm -f .filestoinstall
+
+.PHONY: uninstall
+
+uninstall-doc::
+	@# Extension point
+	$(SHOW)'RM $(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html'
+	$(HIDE)rm -rf "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html"
+	$(SHOW)'RM $(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml'
+	$(HIDE)rm -rf "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml"
+	$(HIDE) rmdir "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/" || true
+.PHONY: uninstall-doc
+
+# Cleaning ####################################################################
+#
+# There rules can be extended in Makefile.local
+# Extensions can't assume when they run.
+
+clean::
+	@# Extension point
+	$(SHOW)'CLEAN'
+	$(HIDE)rm -f $(CMOFILES)
+	$(HIDE)rm -f $(CMIFILES)
+	$(HIDE)rm -f $(CMAFILES)
+	$(HIDE)rm -f $(CMXFILES)
+	$(HIDE)rm -f $(CMXAFILES)
+	$(HIDE)rm -f $(CMXSFILES)
+	$(HIDE)rm -f $(OFILES)
+	$(HIDE)rm -f $(CMXAFILES:.cmxa=.a)
+	$(HIDE)rm -f $(MLGFILES:.mlg=.ml)
+	$(HIDE)rm -f $(CMXFILES:.cmx=.cmt)
+	$(HIDE)rm -f $(MLIFILES:.mli=.cmti)
+	$(HIDE)rm -f $(ALLDFILES)
+	$(HIDE)rm -f $(NATIVEFILES)
+	$(HIDE)find . -name .coq-native -type d -empty -delete
+	$(HIDE)rm -f $(VOFILES)
+	$(HIDE)rm -f $(VOFILES:.vo=.vos)
+	$(HIDE)rm -f $(VOFILES:.vo=.vok)
+	$(HIDE)rm -f $(VOFILES:.vo=.vo.prof.json)
+	$(HIDE)rm -f $(VOFILES:.vo=.vo.prof.json.gz)
+	$(HIDE)rm -f $(BEAUTYFILES) $(VFILES:=.old)
+	$(HIDE)rm -f all.ps all-gal.ps all.pdf all-gal.pdf all.glob all-mli.tex
+	$(HIDE)rm -f $(VFILES:.v=.glob)
+	$(HIDE)rm -f $(VFILES:.v=.tex)
+	$(HIDE)rm -f $(VFILES:.v=.g.tex)
+	$(HIDE)rm -f pretty-timed-success.ok
+	$(HIDE)rm -f META
+	$(HIDE)rm -rf html mlihtml
+.PHONY: clean
+
+cleanall:: clean
+	@# Extension point
+	$(SHOW)'CLEAN *.aux *.timing'
+	$(HIDE)rm -f $(foreach f,$(VFILES:.v=),$(dir $(f)).$(notdir $(f)).aux)
+	$(HIDE)rm -f $(TIME_OF_BUILD_FILE) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE)
+	$(HIDE)rm -f $(VOFILES:.vo=.v.timing)
+	$(HIDE)rm -f $(VOFILES:.vo=.v.before-timing)
+	$(HIDE)rm -f $(VOFILES:.vo=.v.after-timing)
+	$(HIDE)rm -f $(VOFILES:.vo=.v.timing.diff)
+	$(HIDE)rm -f .lia.cache .nia.cache
+.PHONY: cleanall
+
+archclean::
+	@# Extension point
+	$(SHOW)'CLEAN *.cmx *.o'
+	$(HIDE)rm -f $(NATIVEFILES)
+	$(HIDE)rm -f $(CMOFILES:%.cmo=%.cmx)
+.PHONY: archclean
+
+
+# Compilation rules ###########################################################
+
+$(MLIFILES:.mli=.cmi): %.cmi: %.mli
+	$(SHOW)'CAMLC -c $<'
+	$(HIDE)$(TIMER) $(CAMLC) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) $<
+
+$(MLGFILES:.mlg=.ml): %.ml: %.mlg
+	$(SHOW)'COQPP $<'
+	$(HIDE)$(COQPP) $<
+
+# Stupid hack around a deficient syntax: we cannot concatenate two expansions
+$(filter %.cmo, $(MLFILES:.ml=.cmo) $(MLGFILES:.mlg=.cmo)): %.cmo: %.ml
+	$(SHOW)'CAMLC -c $<'
+	$(HIDE)$(TIMER) $(CAMLC) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) $<
+
+# Same hack
+$(filter %.cmx, $(MLFILES:.ml=.cmx) $(MLGFILES:.mlg=.cmx)): %.cmx: %.ml
+	$(SHOW)'CAMLOPT -c $(FOR_PACK) $<'
+	$(HIDE)$(TIMER) $(CAMLOPTC) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) $(FOR_PACK) $<
+
+
+$(MLLIBFILES:.mllib=.cmxs): %.cmxs: %.cmxa
+	$(SHOW)'CAMLOPT -shared -o $@'
+	$(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) \
+		-shared -o $@ $<
+
+$(MLLIBFILES:.mllib=.cma): %.cma: | %.mllib
+	$(SHOW)'CAMLC -a -o $@'
+	$(HIDE)$(TIMER) $(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) -a -o $@ $^
+
+$(MLLIBFILES:.mllib=.cmxa): %.cmxa: | %.mllib
+	$(SHOW)'CAMLOPT -a -o $@'
+	$(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) -a -o $@ $^
+
+
+$(MLPACKFILES:.mlpack=.cmxs): %.cmxs: %.cmxa
+	$(SHOW)'CAMLOPT -shared -o $@'
+	$(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) \
+		-shared -o $@ $<
+
+$(MLPACKFILES:.mlpack=.cmxa): %.cmxa: %.cmx | %.mlpack
+	$(SHOW)'CAMLOPT -a -o $@'
+	$(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) -a -o $@ $<
+
+$(MLPACKFILES:.mlpack=.cma): %.cma: %.cmo | %.mlpack
+	$(SHOW)'CAMLC -a -o $@'
+	$(HIDE)$(TIMER) $(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) -a -o $@ $^
+
+$(MLPACKFILES:.mlpack=.cmo): %.cmo: | %.mlpack
+	$(SHOW)'CAMLC -pack -o $@'
+	$(HIDE)$(TIMER) $(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) -pack -o $@ $^
+
+$(MLPACKFILES:.mlpack=.cmx): %.cmx: | %.mlpack
+	$(SHOW)'CAMLOPT -pack -o $@'
+	$(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) -pack -o $@ $^
+
+# This rule is for _CoqProject with no .mllib nor .mlpack
+$(filter-out $(MLLIBFILES:.mllib=.cmxs) $(MLPACKFILES:.mlpack=.cmxs) $(addsuffix .cmxs,$(PACKEDFILES)) $(addsuffix .cmxs,$(LIBEDFILES)),$(MLFILES:.ml=.cmxs) $(MLGFILES:.mlg=.cmxs)): %.cmxs: %.cmx
+	$(SHOW)'[deprecated,use-mllib-or-mlpack] CAMLOPT -shared -o $@'
+	$(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) \
+		-shared -o $@ $<
+
+# can't make
+# https://www.gnu.org/software/make/manual/make.html#Static-Pattern
+# work with multiple target rules
+# so use eval in a loop instead
+# with grouped targets https://www.gnu.org/software/make/manual/make.html#Multiple-Targets
+# if available (GNU Make >= 4.3)
+ifneq (,$(filter grouped-target,$(.FEATURES)))
+define globvorule=
+
+# take care to $$ variables using $< etc
+  $(1).vo $(1).glob &: $(1).v | $$(VDFILE)
+	$$(SHOW)ROCQ compile $(1).v
+	$$(HIDE)$$(TIMER) $$(ROCQ) compile $$(COQDEBUG) $$(TIMING_ARG) $$(PROFILE_ARG) $$(COQFLAGS) $$(COQLIBS) $(1).v
+	$$(HIDE)$$(PROFILE_ZIP)
+ifeq ($(COQDONATIVE), "yes")
+	$$(SHOW)COQNATIVE $(1).vo
+	$$(HIDE)$$(call TIMER,$(1).vo.native) $$(COQNATIVE) $$(COQLIBS) $(1).vo
+endif
+
+endef
+else
+
+$(VOFILES): %.vo: %.v | $(VDFILE)
+	$(SHOW)ROCQ compile $<
+	$(HIDE)$(TIMER) $(ROCQ) compile $(COQDEBUG) $(TIMING_ARG) $(PROFILE_ARG) $(COQFLAGS) $(COQLIBS) $<
+	$(HIDE)$(PROFILE_ZIP)
+ifeq ($(COQDONATIVE), "yes")
+	$(SHOW)COQNATIVE $@
+	$(HIDE)$(call TIMER,$@.native) $(COQNATIVE) $(COQLIBS) $@
+endif
+
+# this is broken :( todo fix if we ever find a solution that doesn't need grouped targets
+$(GLOBFILES): %.glob: %.v
+	$(SHOW)'ROCQ compile $< (for .glob)'
+	$(HIDE)$(TIMER) $(ROCQ) compile $(COQDEBUG) $(COQFLAGS) $(COQLIBS) $<
+
+endif
+
+$(foreach vfile,$(VFILES:.v=),$(eval $(call globvorule,$(vfile))))
+
+$(VFILES:.v=.vos): %.vos: %.v
+	$(SHOW)ROCQ compile -vos $<
+	$(HIDE)$(TIMER) $(ROCQ) compile -vos $(COQDEBUG) $(COQFLAGS) $(COQLIBS) $<
+
+$(VFILES:.v=.vok): %.vok: %.v
+	$(SHOW)ROCQ compile -vok $<
+	$(HIDE)$(TIMER) $(ROCQ) compile -vok $(COQDEBUG) $(COQFLAGS) $(COQLIBS) $<
+
+$(addsuffix .timing.diff,$(VFILES)): %.timing.diff : %.before-timing %.after-timing
+	$(SHOW)PYTHON TIMING-DIFF $*.{before,after}-timing
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" print-pretty-single-time-diff BEFORE=$*.before-timing AFTER=$*.after-timing TIME_OF_PRETTY_BUILD_FILE="$@"
+
+$(BEAUTYFILES): %.v.beautified: %.v
+	$(SHOW)'BEAUTIFY $<'
+	$(HIDE)$(TIMER) $(ROCQ) compile $(COQDEBUG) $(COQFLAGS) $(COQLIBS) -beautify $<
+
+$(TEXFILES): %.tex: %.v
+	$(SHOW)'COQDOC -latex $<'
+	$(HIDE)$(COQDOC) $(COQDOCFLAGS) -latex $< -o $@
+
+$(GTEXFILES): %.g.tex: %.v
+	$(SHOW)'COQDOC -latex -g $<'
+	$(HIDE)$(COQDOC) $(COQDOCFLAGS) -latex -g $< -o $@
+
+$(HTMLFILES): %.html: %.v %.glob
+	$(SHOW)'COQDOC -html $<'
+	$(HIDE)$(COQDOC) $(COQDOCFLAGS) -html $< -o $@
+
+$(GHTMLFILES): %.g.html: %.v %.glob
+	$(SHOW)'COQDOC -html -g $<'
+	$(HIDE)$(COQDOC) $(COQDOCFLAGS)  -html -g $< -o $@
+
+# Dependency files ############################################################
+
+ifndef MAKECMDGOALS
+  -include $(ALLDFILES)
+else
+  ifneq ($(filter-out archclean clean cleanall printenv make-pretty-timed make-pretty-timed-before make-pretty-timed-after print-pretty-timed print-pretty-timed-diff print-pretty-single-time-diff,$(MAKECMDGOALS)),)
+   -include $(ALLDFILES)
+ endif
+endif
+
+.SECONDARY: $(ALLDFILES)
+
+redir_if_ok = > "$@" || ( RV=$$?; rm -f "$@"; exit $$RV )
+
+GENMLFILES:=$(MLGFILES:.mlg=.ml)
+$(addsuffix .d,$(ALLSRCFILES)): $(GENMLFILES)
+
+$(addsuffix .d,$(MLIFILES)): %.mli.d: %.mli
+	$(SHOW)'CAMLDEP $<'
+	$(HIDE)$(CAMLDEP) $(OCAMLLIBS) "$<" $(redir_if_ok)
+
+$(addsuffix .d,$(MLGFILES)): %.mlg.d: %.ml
+	$(SHOW)'CAMLDEP $<'
+	$(HIDE)$(CAMLDEP) $(OCAMLLIBS) "$<" $(redir_if_ok)
+
+$(addsuffix .d,$(MLFILES)): %.ml.d: %.ml
+	$(SHOW)'CAMLDEP $<'
+	$(HIDE)$(CAMLDEP) $(OCAMLLIBS) "$<" $(redir_if_ok)
+
+$(addsuffix .d,$(MLLIBFILES)): %.mllib.d: %.mllib
+	$(SHOW)'OCAMLLIBDEP $<'
+	$(HIDE)$(OCAMLLIBDEP) -c $(OCAMLLIBS) "$<" $(redir_if_ok)
+
+$(addsuffix .d,$(MLPACKFILES)): %.mlpack.d: %.mlpack
+	$(SHOW)'OCAMLLIBDEP $<'
+	$(HIDE)$(OCAMLLIBDEP) -c $(OCAMLLIBS) "$<" $(redir_if_ok)
+
+# If this makefile is created using a _CoqProject we have coqdep get
+# options from it. This avoids argument length limits for pathological
+# projects. Note that extra options might be on the command line.
+VDFILE_FLAGS:=$(if _CoqProject,-f _CoqProject,) $(CMDLINE_COQLIBS) $(CMDLINE_VFILES)
+
+$(VDFILE): _CoqProject $(VFILES)
+	$(SHOW)'ROCQ DEP VFILES'
+	$(HIDE)$(TIMER) $(COQDEP) -vos -dyndep var $(VDFILE_FLAGS) $(redir_if_ok)
+
+# Misc ########################################################################
+
+byte:
+	$(HIDE)$(MAKE) all "OPT:=-byte" -f "$(SELF)"
+.PHONY: byte
+
+opt:
+	$(HIDE)$(MAKE) all "OPT:=-opt" -f "$(SELF)"
+.PHONY:	opt
+
+# This is deprecated.  To extend this makefile use
+# extension points and Makefile.local
+printenv::
+	$(warning printenv is deprecated)
+	$(warning write extensions in Makefile.local or include Makefile.conf)
+	@echo 'COQLIB = $(COQLIB)'
+	@echo 'COQCORELIB = $(COQCORELIB)'
+	@echo 'DOCDIR = $(DOCDIR)'
+	@echo 'OCAMLFIND = $(OCAMLFIND)'
+	@echo 'HASNATDYNLINK = $(HASNATDYNLINK)'
+	@echo 'SRC_SUBDIRS = $(SRC_SUBDIRS)'
+	@echo 'COQ_SRC_SUBDIRS = $(COQ_SRC_SUBDIRS)'
+	@echo 'COQCORE_SRC_SUBDIRS = $(COQCORE_SRC_SUBDIRS)'
+	@echo 'OCAMLFIND = $(OCAMLFIND)'
+	@echo 'PP = $(PP)'
+	@echo 'COQFLAGS = $(COQFLAGS)'
+	@echo 'COQLIB = $(COQLIBS)'
+	@echo 'COQLIBINSTALL = $(COQLIBINSTALL)'
+	@echo 'COQDOCINSTALL = $(COQDOCINSTALL)'
+.PHONY:	printenv
+
+# Generate a .merlin file.  If you need to append directives to this
+# file you can extend the merlin-hook target in Makefile.local
+.merlin:
+	$(SHOW)'FILL .merlin'
+	$(HIDE)echo 'FLG $(COQMF_CAMLFLAGS)' > .merlin
+	$(HIDE)echo 'B $(COQCORELIB)' >> .merlin
+	$(HIDE)echo 'S $(COQCORELIB)' >> .merlin
+	$(HIDE)$(foreach d,$(COQCORE_SRC_SUBDIRS), \
+		echo 'B $(COQCORELIB)$(d)' >> .merlin;)
+	$(HIDE)$(foreach d,$(COQ_SRC_SUBDIRS), \
+		echo 'S $(COQLIB)$(d)' >> .merlin;)
+	$(HIDE)$(foreach d,$(SRC_SUBDIRS), echo 'B $(d)' >> .merlin;)
+	$(HIDE)$(foreach d,$(SRC_SUBDIRS), echo 'S $(d)' >> .merlin;)
+	$(HIDE)$(MAKE) merlin-hook -f "$(SELF)"
+.PHONY: merlin
+
+merlin-hook::
+	@# Extension point
+.PHONY: merlin-hook
+
+# prints all variables
+debug:
+	$(foreach v,\
+		$(sort $(filter-out $(INITIAL_VARS) INITIAL_VARS,\
+	       		$(.VARIABLES))),\
+	       	$(info $(v) = $($(v))))
+.PHONY: debug
+
+.DEFAULT_GOAL := all
+
+# Users can create Makefile.local-late to hook into double-colon rules
+# or add other needed Makefile code, using defined
+# variables if necessary.
+-include Makefile.local-late
+
+# Local Variables:
+# mode: makefile-gmake
+# End:
diff --git a/Makefile.conf b/Makefile.conf
new file mode 100644
index 00000000..f5a69775
--- /dev/null
+++ b/Makefile.conf
@@ -0,0 +1,71 @@
+# This configuration file was generated by running:
+# coq_makefile -f _CoqProject -o Makefile
+
+COQBIN?=
+ifneq (,$(COQBIN))
+# add an ending /
+COQBIN:=$(COQBIN)/
+endif
+COQMKFILE ?= "$(COQBIN)rocq" makefile
+
+###############################################################################
+#                                                                             #
+# Project files.                                                              #
+#                                                                             #
+###############################################################################
+
+COQMF_CMDLINE_VFILES := 
+COQMF_SOURCES := $(shell $(COQMKFILE) -sources-of -f _CoqProject $(COQMF_CMDLINE_VFILES))
+COQMF_VFILES := $(filter %.v, $(COQMF_SOURCES))
+COQMF_MLIFILES := $(filter %.mli, $(COQMF_SOURCES))
+COQMF_MLFILES := $(filter %.ml, $(COQMF_SOURCES))
+COQMF_MLGFILES := $(filter %.mlg, $(COQMF_SOURCES))
+COQMF_MLPACKFILES := $(filter %.mlpack, $(COQMF_SOURCES))
+COQMF_MLLIBFILES := $(filter %.mllib, $(COQMF_SOURCES))
+COQMF_METAFILE = 
+
+###############################################################################
+#                                                                             #
+# Path directives (-I, -R, -Q).                                               #
+#                                                                             #
+###############################################################################
+
+COQMF_OCAMLLIBS = 
+COQMF_SRC_SUBDIRS = 
+COQMF_COQLIBS =  -Q theories ITree -Q extra ITree.Extra 
+COQMF_COQLIBS_NOML = -Q theories ITree -Q extra ITree.Extra 
+COQMF_CMDLINE_COQLIBS =   
+
+###############################################################################
+#                                                                             #
+# Rocq configuration.                                                         #
+#                                                                             #
+###############################################################################
+
+COQMF_COQLIB=/Users/rogerab/.opam/default/lib/coq/
+COQMF_COQCORELIB=/Users/rogerab/.opam/default/lib/coq/../rocq-runtime/
+COQMF_DOCDIR=/Users/rogerab/.opam/default/share/doc/
+COQMF_OCAMLFIND=/Users/rogerab/.opam/default/bin/ocamlfind
+COQMF_CAMLFLAGS=-thread -bin-annot -strict-sequence -w -a+1..3-4+5..8-9+10..26-27+28..39-40-41-42+43-44-45+46..47-48+49..57-58+59..66-67-68+69-70
+COQMF_WARN=-warn-error +a-3
+COQMF_HASNATDYNLINK=true
+COQMF_COQ_SRC_SUBDIRS=boot config lib clib kernel library engine pretyping interp gramlib parsing proofs tactics toplevel printing ide stm vernac plugins/btauto plugins/cc plugins/derive plugins/extraction plugins/firstorder plugins/funind plugins/ltac plugins/ltac2 plugins/ltac2_ltac1 plugins/micromega plugins/nsatz plugins/ring plugins/rtauto plugins/ssr plugins/ssrmatching plugins/syntax
+COQMF_COQ_NATIVE_COMPILER_DEFAULT=no
+COQMF_WINDRIVE=
+
+###############################################################################
+#                                                                             #
+# Native compiler.                                                            #
+#                                                                             #
+###############################################################################
+
+COQMF_COQPROJECTNATIVEFLAG = 
+
+###############################################################################
+#                                                                             #
+# Extra variables.                                                            #
+#                                                                             #
+###############################################################################
+
+COQMF_OTHERFLAGS = 
+COQMF_INSTALLCOQDOCROOT = ITree
diff --git a/README.md b/README.md
index 4f13227a..9b0052c0 100644
--- a/README.md
+++ b/README.md
@@ -35,7 +35,7 @@ opam install coq-itree
 ### Dependencies
 
 - [coq](https://coq.inria.fr/)
-- [coq-paco](https://github.com/snu-sf/paco)
+- [rocq-coinduction](https://github.com/damien-pous/coinduction)
 - [coq-ext-lib](https://github.com/coq-community/coq-ext-lib)
 
 See [`coq-itree.opam`](./coq-itree.opam) for version details.
diff --git a/REFACTOR-TODOS.md b/REFACTOR-TODOS.md
new file mode 100644
index 00000000..65e3275a
--- /dev/null
+++ b/REFACTOR-TODOS.md
@@ -0,0 +1,25 @@
+- [ ] Generally clean up Eqit.v. 
+  - [ ] rename and redo sections
+  - [ ] keep building tests until rewriting robustness is clear
+    - [ ] organize file
+    - [ ] remove add parametric morphism
+- [ ] rest of rtodos 
+
+- [ ] get tutorial building 
+- unify how we deal with each node of a tree. 
+
+- rets: a constructor pattern that either concludes or leads to computation.
+- taus: coinductive conclusion. 
+- single tau: simple inductive conclusion. 
+- vis: this is the tricky one, and the strongest reason for a unified front. 
+there is some inv_Vis, some dependent destruction, some vis_gen... we need a 
+single pipeline for concluding proofs about vis nodes. 
+    - the 'refine match' pattern that appears here is not lovely either. 
+      See Finite.v. 
+
+- [ ] Get "MWE ITree library" for RIP volume
+      - want highlights of itrees 
+NEXT: 
+- [ ] Gather and organize knowledge for talk and RIP presentation about 
+      how one would teach the essentials of itrees. 
+- [ ] 
\ No newline at end of file
diff --git a/_CoqProject b/_CoqProject
new file mode 100644
index 00000000..d5847a7c
--- /dev/null
+++ b/_CoqProject
@@ -0,0 +1,110 @@
+# THIS IS AN AUTOMATICALLY GENERATED FILE
+# PLEASE EDIT _CoqConfig INSTEAD
+
+-Q theories ITree
+
+theories/Simple.v
+theories/ITree.v
+theories/ITreeFacts.v
+theories/Axioms.v
+
+theories/Basics/Utils.v
+theories/Basics/Basics.v
+theories/Basics/HeterogeneousRelations.v
+theories/Basics/Category.v
+theories/Basics/CategoryOps.v
+theories/Basics/CategoryTheory.v
+theories/Basics/CategoryFacts.v
+theories/Basics/CategorySub.v
+theories/Basics/CategoryFunctor.v
+theories/Basics/CategoryRelations.v
+theories/Basics/Monad.v
+theories/Basics/MonadProp.v
+theories/Basics/MonadState.v
+theories/Basics/CategoryKleisli.v
+theories/Basics/CategoryKleisliFacts.v
+theories/Basics/Function.v
+theories/Basics/FunctionFacts.v
+
+theories/Core/ITreeDefinition.v
+theories/Core/KTree.v
+theories/Core/KTreeFacts.v
+theories/Core/Subevent.v
+theories/Core/ITreeMonad.v
+
+theories/Eq.v
+theories/Eq/Shallow.v
+theories/Eq/Eqit.v
+theories/Eq/SimUpToTaus.v
+theories/Eq/EqAxiom.v
+theories/Eq/Rutt.v
+theories/Eq/RuttFacts.v
+
+theories/Props/Leaf.v
+theories/Props/Finite.v
+theories/Props/HasPost.v
+theories/Props/Infinite.v
+theories/Props/Cofinite.v
+theories/Props/EuttNoRet.v
+
+theories/Indexed/Sum.v
+theories/Indexed/Relation.v
+theories/Indexed/Function.v
+theories/Indexed/FunctionFacts.v
+
+theories/Interp/Interp.v
+theories/Interp/TranslateFacts.v
+theories/Interp/InterpFacts.v
+theories/Interp/Handler.v
+theories/Interp/HandlerFacts.v
+theories/Interp/Recursion.v
+theories/Interp/RecursionFacts.v
+theories/Interp/Traces.v
+
+theories/Events.v
+theories/Events/State.v
+theories/Events/StateFacts.v
+theories/Events/Reader.v
+theories/Events/Writer.v
+theories/Events/Exception.v
+theories/Events/ExceptionFacts.v
+theories/Events/Nondeterminism.v
+theories/Events/Map.v
+theories/Events/MapDefault.v
+theories/Events/MapDefaultFacts.v
+theories/Events/Concurrency.v
+theories/Events/Dependent.v
+theories/Events/FailFacts.v
+-Q extra ITree.Extra
+
+extra/IForest.v
+
+extra/ITrace/ITraceDefinition.v
+extra/ITrace/ITraceFacts.v
+extra/ITrace/ITracePrefix.v
+extra/ITrace/ITraceBind.v
+extra/ITrace/ITracePreds.v
+
+extra/Dijkstra/DijkstraMonad.v
+extra/Dijkstra/IterRel.v
+extra/Dijkstra/PureITreeBasics.v
+extra/Dijkstra/PureITreeDijkstra.v
+extra/Dijkstra/DelaySpecMonad.v
+extra/Dijkstra/StateSpecT.v
+extra/Dijkstra/StateDelaySpec.v
+extra/Dijkstra/TracesIT.v
+extra/Dijkstra/ITreeDijkstra.v
+extra/Dijkstra/StateIOTrace.v
+
+extra/Secure/Labels.v
+extra/Secure/StrongBisimProper.v
+extra/Secure/SecureEqHalt.v
+extra/Secure/SecureEqHaltProgInsens.v
+extra/Secure/SecureEqEuttHalt.v
+extra/Secure/SecureEqEuttTrans.v
+extra/Secure/SecureEqWcompat.v
+extra/Secure/SecureEqBind.v
+extra/Secure/SecureEqProgInsens.v
+extra/Secure/SecureEqProgInsensFacts.v
+extra/Secure/SecureStateHandler.v
+extra/Secure/SecureStateHandlerPi.v
diff --git a/_CoqProject.backup b/_CoqProject.backup
new file mode 100644
index 00000000..ef1176f7
--- /dev/null
+++ b/_CoqProject.backup
@@ -0,0 +1,5 @@
+-Q _build/default/theories ITree
+-Q _build/default/extra ITree.Extra
+-Q _build/default/examples ITreeExamples
+-Q _build/default/tutorial ITreeTutorial
+-Q _build/default/tests ITreeTests
diff --git a/_CoqProject.itree b/_CoqProject.itree
index 19cd3bfe..7c29b64f 100644
--- a/_CoqProject.itree
+++ b/_CoqProject.itree
@@ -23,6 +23,7 @@ theories/Basics/CategoryKleisliFacts.v
 theories/Basics/Function.v
 theories/Basics/FunctionFacts.v
 
+theories/Core/Utils.v
 theories/Core/ITreeDefinition.v
 theories/Core/KTree.v
 theories/Core/KTreeFacts.v
@@ -30,13 +31,10 @@ theories/Core/Subevent.v
 theories/Core/ITreeMonad.v
 
 theories/Eq.v
-theories/Eq/Paco2.v
 theories/Eq/Shallow.v
 theories/Eq/Eqit.v
-theories/Eq/UpToTaus.v
 theories/Eq/SimUpToTaus.v
 theories/Eq/EqAxiom.v
-theories/Eq/EuttExtras.v
 theories/Eq/Rutt.v
 theories/Eq/RuttFacts.v
 
diff --git a/coq-itree-extra.opam b/coq-itree-extra.opam
index 4888f210..ab2f5494 100644
--- a/coq-itree-extra.opam
+++ b/coq-itree-extra.opam
@@ -14,7 +14,7 @@ depends: [
   "dune" {>= "2.6"}
   "coq"
   "coq-ext-lib"
-  "coq-paco"
+  "rocq-coinduction"
   "coq-itree"
 ]
 dev-repo: "git+https://github.com/DeepSpec/InteractionTrees.git"
diff --git a/coq-itree.opam b/coq-itree.opam
index 952150fb..9accab88 100644
--- a/coq-itree.opam
+++ b/coq-itree.opam
@@ -21,7 +21,7 @@ depends: [
   "dune" {>= "2.6"}
   "coq" {>= "8.14"}
   "coq-ext-lib" {>= "0.11.1"}
-  "coq-paco" {>= "4.2.1"}
+  "rocq-coinduction" {>= "1.21"}
 ]
 build: [
   ["dune" "subst"] {pinned}
diff --git a/dune-project b/dune-project
index 6e8d191c..71756e73 100644
--- a/dune-project
+++ b/dune-project
@@ -12,7 +12,7 @@
   (depends
     (coq (>= 8.14))
     (coq-ext-lib (>= 0.11.1))
-    (coq-paco (>= 4.2.1)))
+    (rocq-coinduction (>= 1.21)))
   (tags ("org:deepspec"))
   (authors
     "Li-yao Xia"
@@ -30,7 +30,7 @@
   (depends
     coq
     coq-ext-lib
-    coq-paco
+    rocq-coinduction
     coq-itree)
   (tags ("org:deepspec"))
   (authors
diff --git a/examples/ITreePredicatesExample.v b/examples/ITreePredicatesExample.v
index 56861f78..204e94e3 100644
--- a/examples/ITreePredicatesExample.v
+++ b/examples/ITreePredicatesExample.v
@@ -5,13 +5,14 @@
 (* TODO: this infrastructure should be generalized and integrated into
    the library. *)
 
+From Coinduction Require Import all. 
+
 Set Implicit Arguments.
 Set Contextual Implicit.
 
-From Coq Require Import
+From Stdlib Require Import
      Morphisms.
 
-From Paco Require Import paco.
 
 From ExtLib Require Import
      Monads.
@@ -19,10 +20,7 @@ From ExtLib Require Import
 From ITree Require Import
      Axioms
      ITree
-     ITreeFacts
-     Eq.Paco2.
-
-From Paco Require Import paco.
+     ITreeFacts.
 
 Import ITreeNotations.
 
@@ -94,22 +92,25 @@ Section Proper.
   Local Open Scope signature_scope.
 
 
-  (* SAZ: This proof is a bit annoying.  We can only rewrite under the "upto" paco2 predicate
+  (* 
+  TOUR: This proof is now nice! 
+  Old: 
+  SAZ: This proof is a bit annoying.  We can only rewrite under the "upto" paco2 predicate
      (see the eq_itree_paco instance in Eq), which means we have to introduce names, start the upto proof,
      do the rewrite, and then regeneralize for the CIH.  It would be nicer if we could rewrite under (paco2 _ r).
    *)
   Instance proper_interpret_state {S R} : Proper ((@eq_itree (stateE S) R _ eq) ==> (@eq S) ==> (@eq_itree void1 (S * R) _ eq)) interpret_state.
   Proof.
-    ginit. gcofix CIH.
+    coinduction. 
     intros x y H0 x2 y0 H1.
     rewrite (itree_eta (interpret_state x x2)).
     rewrite (itree_eta (interpret_state y y0)).
     rewrite !unfold_interpret_state. subst.
-    punfold H0. repeat red in H0. unfold interpret_stateF.
-    destruct (observe x); inv H0; try discriminate; pclearbot; simpl;
-      try (gstep; constructor; eauto with paco; fail).
+    step in H0. unfold interpret_stateF.
+    destruct (observe x); inv H0; try discriminate; simpl;
+      try (constructor; eauto).
     ddestruction.
-    destruct e; gstep; econstructor; eauto with paco itree.
+    destruct e; econstructor; eauto with itree.
   Qed.
 
   End Proper.
@@ -170,6 +171,8 @@ Definition NoGets_ {S R} (rec : itree (stateE S) R -> Prop) (t : itree (stateE S
   NoGetsF rec (observe t).
 
 
+  (* RTODO: Rewrite all this *)
+  (* TOUR: all of this greivance no longer applies! *)
 (* Next, we need to prove that [NoGets_] is a monotone function on relations,
    which means that paco can take its greatest fixpoint.  Monotonicity of
    [NoGets_] depends on monotonicity of [NoGetsF].
@@ -189,26 +192,28 @@ Definition NoGets_ {S R} (rec : itree (stateE S) R -> Prop) (t : itree (stateE S
    that it isn't an instance of monotone1.
 *)
 
-Lemma monotone_NoGetsF : forall {S R} t (r r' : itree (stateE S) R -> Prop)
-  (IN: NoGetsF r t) (LE: forall y, r y -> r' y), NoGetsF r' t.
-Proof.
-  pmonauto.
-Qed.
+Lemma NoGetsF_mono : forall {S R},
+  Proper (leq ==> leq) (@NoGets_ S R). 
+Proof. monauto. Qed.
 
-(* SAZ: we need to do a couple of reductions to expose the structure of
+
+Definition NoGets_mon S R := Build_mon (@NoGetsF_mono S R). 
+
+(* TOUR: No need! *)
+(* (* SAZ: we need to do a couple of reductions to expose the structure of
    the lemma so that pmonauto can work.  Note that [cbn] and [simple]
    don't work here because they don't unfold the definitions.  *)
 Lemma monotone_NoGets_ : forall {S R}, monotone1 (@NoGets_ S R).
 Proof.
   do 2 red. pmonauto.
 Qed.
-Global Hint Resolve monotone_NoGets_ : paco.
+Global Hint Resolve monotone_NoGets_ : paco. *)
 
 (* Finally, we can define the [NoGets] predicate by simply applying paco1
    starting from bot1 (the least prediate).  We would use paco2 and bot2 for a
    binary relation, paco3 and bot3 for ternary, etc. *)
 
-Definition NoGets {S R} : itree (stateE S) R -> Prop := paco1 NoGets_ bot1.
+Definition NoGets {S R} : itree (stateE S) R -> Prop := gfp (@NoGets_mon S R).
 
 
 (* Using a coinductive predicate -------------------------------------------- *)
@@ -234,23 +239,20 @@ Lemma state_independent : forall {S R} (t:itree (stateE S) R)
     forall s s', ('(s,x) <- interpret_state t s ;; ret x) ≅ ('(s,x) <- interpret_state t s' ;; ret x).
 Proof.
   intros S R.
-  ginit. gcofix CIH.
+  coinduction. 
   intros t H0 s s'.
   rewrite (itree_eta (interpret_state t s)).
   rewrite (itree_eta (interpret_state t s')).
   rewrite !unfold_interpret_state.
   unfold interpret_stateF.
-  punfold H0. repeat red in H0.
+  step in H0.  
   destruct (observe t); cbn.
-  - rewrite !bind_ret_l. gstep. econstructor. eauto.
-  - rewrite !bind_tau. gstep. econstructor.
-    gbase. eapply CIH.
-    inversion H0. subst. pclearbot. assumption.
+  - reflexivity. 
+  - taus. eapply CIH. 
+    inversion H0. subst.  assumption.
   - destruct e; cbn.
     + (* e is Get, which is ruled out by the NoGets predicate *) inversion H0.
-    + rewrite !bind_tau.
-      gstep. econstructor. gbase. eapply CIH.
-      inversion H0. ddestruction. pclearbot. assumption.
+    + reflexivity. 
 Qed.
 
 
@@ -266,24 +268,21 @@ Lemma state_independent_k : forall {S R U} (t:itree (stateE S) R)
     forall s s', (sx <- interpret_state t s ;; (k sx)) ≅ (sx <- interpret_state t s' ;; (k sx)).
 Proof.
   intros S R U.
-  ginit. gcofix CIH.
+  coinduction. 
   intros t H0 k INV s s'.
   rewrite (itree_eta (interpret_state t s)).
   rewrite (itree_eta (interpret_state t s')).
   rewrite !unfold_interpret_state.
   unfold interpret_stateF.
-  punfold H0. repeat red in H0.
+  step in H0. repeat red in H0.
   destruct (observe t); cbn.
-  - rewrite !bind_ret_l. gfinal. right.
-    eapply paco2_mon_bot; eauto with paco. apply INV.
-  - rewrite !bind_tau. gstep. econstructor.
-    gbase. eapply CIH; auto.
-    inversion H0. subst. pclearbot. assumption.
+  - rewrite !bind_ret_l. step. apply INV.
+  - constructor.
+    eapply CIH; auto.
+    inversion H0. subst. assumption.
   - destruct e; cbn.
     + (* e is Get, which is ruled out by the NoGets predicate *) inversion H0.
-    + rewrite !bind_tau.
-      gstep. econstructor. gbase. eapply CIH; auto.
-      inversion H0. ddestruction. pclearbot. assumption.
+    + reflexivity.
 Qed.
 
 Theorem state_independent': forall {S R} (t:itree (stateE S) R)
@@ -292,6 +291,4 @@ Theorem state_independent': forall {S R} (t:itree (stateE S) R)
 Proof.
   intros S R t H s s'.
   eapply state_independent_k; eauto.
-  intros.
-  reflexivity.
 Qed.
diff --git a/examples/IntroductionSolutions.v b/examples/IntroductionSolutions.v
index 3a6f9d89..f295cef9 100644
--- a/examples/IntroductionSolutions.v
+++ b/examples/IntroductionSolutions.v
@@ -13,7 +13,7 @@
  *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Arith
      Lia
      List.
diff --git a/examples/LC.v b/examples/LC.v
index ad5c8c57..f3ae57bc 100644
--- a/examples/LC.v
+++ b/examples/LC.v
@@ -1,6 +1,6 @@
 (* Big-step reduction of untyped lambda terms. *)
 
-From Coq Require Import Arith.
+From Stdlib Require Import Arith.
 
 From ExtLib.Structures Require Import
      Monad.
diff --git a/examples/MultiThreadedPrinting.v b/examples/MultiThreadedPrinting.v
index 3ab26fe5..015af628 100644
--- a/examples/MultiThreadedPrinting.v
+++ b/examples/MultiThreadedPrinting.v
@@ -1,7 +1,7 @@
 Set Implicit Arguments.
 Set Contextual Implicit.
 
-From Coq Require Import
+From Stdlib Require Import
      String.
 
 From ITree Require Import
diff --git a/examples/Nimp.v b/examples/Nimp.v
index 66cbbc35..5c793714 100644
--- a/examples/Nimp.v
+++ b/examples/Nimp.v
@@ -1,6 +1,7 @@
 (* A nondeterministic Imp *)
+From Coinduction Require Import all. 
 
-From Coq Require Import
+From Stdlib Require Import
      Relations.
 
 From ITree Require Import
@@ -29,24 +30,24 @@ Example choose_loop : com := choose (loop skip) skip.
 (* Unlabeled small-step *)
 Module Unlabeled.
 
-Reserved Infix "-->" (at level 80, no associativity).
+Reserved Infix "--->" (at level 80, no associativity).
 
 Inductive step : relation com :=
 | step_loop_stop c :
-    loop c --> skip
+    loop c ---> skip
 | step_loop_go c :
-    loop c --> (c ;; loop c)
+    loop c ---> (c ;; loop c)
 | step_choose_l c1 c2 :
-    choose c1 c2 --> c1
+    choose c1 c2 ---> c1
 | step_choose_r c1 c2 :
-    choose c1 c2 --> c2
+    choose c1 c2 ---> c2
 | step_seq_go c1 c1' c2 :
-    c1 --> c2 ->
-    (c1 ;; c2) --> (c1' ;; c2)
+    c1 ---> c2 ->
+    (c1 ;; c2) ---> (c1' ;; c2)
 | step_seq_next c2 :
-    (skip ;; c2) --> c2
+    (skip ;; c2) ---> c2
 
-where "x --> y" := (step x y).
+where "x ---> y" := (step x y).
 
 CoInductive infinite_steps (c : com) : Type :=
 | more c' : step c c' -> infinite_steps c' -> infinite_steps c.
@@ -65,30 +66,30 @@ End Unlabeled.
 
 Module Labeled.
 
-Reserved Notation "s --> t" (at level 80, no associativity).
-Reserved Notation "s ! b --> t" (at level 80, b at next level, no associativity).
-Reserved Notation "s ? b --> t" (at level 80, b at next level, no associativity).
+Reserved Notation "s ---> t" (at level 80, no associativity).
+Reserved Notation "s ! b ---> t" (at level 80, b at next level, no associativity).
+Reserved Notation "s ? b ---> t" (at level 80, b at next level, no associativity).
 
 Variant label := tau | bit (b : bool).
 
 Inductive step : label -> relation com :=
 | step_loop_stop c :
-    loop c ! true --> skip
+    loop c ! true ---> skip
 | step_loop_go c :
-    loop c ! false --> (c ;; loop c)
+    loop c ! false ---> (c ;; loop c)
 | step_choose_l c1 c2 :
-    choose c1 c2 ! true --> c1
+    choose c1 c2 ! true ---> c1
 | step_choose_r c1 c2 :
-    choose c1 c2 ! false --> c2
+    choose c1 c2 ! false ---> c2
 | step_seq_go b c1 c1' c2 :
-    c1 ? b --> c2 ->
-    (c1 ;; c2) ? b --> (c1' ;; c2)
+    c1 ? b ---> c2 ->
+    (c1 ;; c2) ? b ---> (c1' ;; c2)
 | step_seq_next c2 :
-    (skip ;; c2) --> c2
+    (skip ;; c2) ---> c2
 
-where "x --> y" := (step tau x y)
-and  "x ! b --> y" := (step (bit b) x y)
-and  "x ? b --> y" := (step b x y).
+where "x ---> y" := (step tau x y)
+and  "x ! b ---> y" := (step (bit b) x y)
+and  "x ? b ---> y" := (step b x y).
 
 CoInductive infinite_steps (c : com) : Type :=
 | more b c' : step b c c' -> infinite_steps c' -> infinite_steps c.
@@ -105,8 +106,6 @@ Qed.
 
 End Labeled.
 
-From Paco Require Import paco.
-
 Module Tree.
 
 Variant nd : Type -> Prop :=
@@ -146,7 +145,7 @@ Definition one_loop_tree : itree nd unit :=
     else
       trigger (Call tt))%itree tt.
 
-Import Coq.Classes.Morphisms.
+Import Stdlib.Classes.Morphisms.
 
 Lemma eval_skip: rec eval_def skip ≈ Ret tt.
 Proof.
@@ -156,24 +155,23 @@ Qed.
 (* SAZ: the [~] notation for eutt wasn't working here. *)
 Lemma eval_one_loop : eval one_loop ≈ one_loop_tree.
 Proof.
-  einit. ecofix CIH. edrop.
-  setoid_rewrite rec_as_interp.
-  setoid_rewrite interp_bind.
-  setoid_rewrite interp_vis.
-  setoid_rewrite tau_eutt.
-  setoid_rewrite interp_ret.
-  setoid_rewrite bind_bind.
-  setoid_rewrite bind_ret_l.
-  setoid_rewrite bind_vis.
-  evis. intros.
-  setoid_rewrite bind_ret_l.
-  destruct v.
-  - setoid_rewrite interp_ret. apply reflexivity.
-  - setoid_rewrite interp_bind.
-    setoid_rewrite interp_recursive_call.
-    setoid_rewrite eval_skip.
-    setoid_rewrite bind_ret_l.
-    eauto with paco.
+  coinduction c CIH.
+  unfold eval, one_loop, one_loop_tree, rec, mrec.
+  rewrite 2 unfold_interp_mrec. cbn.
+  constructor. intros x.
+  rewrite 2 tau_euttge.  
+  destruct x.
+  - rewrite 2 unfold_interp_mrec. cbn. reflexivity.
+  - ITree.fold_subst. 
+    rewrite 2 bind_ret_. 
+    rewrite interp_mrec_bind.  
+    rewrite unfold_interp_mrec. cbn. 
+    rewrite tau_euttge. 
+    rewrite bind_ret_.
+    rewrite <- interp_mrec_bind. 
+    rewrite bind_ret_.  
+    rewrite 2 interp_mrec_trigger. 
+    eapply CIH.  
 Qed.
 
 End Tree.
diff --git a/examples/STLC.v b/examples/STLC.v
index c16f44ed..685d0ef0 100644
--- a/examples/STLC.v
+++ b/examples/STLC.v
@@ -1,4 +1,4 @@
-From Coq Require Import
+From Stdlib Require Import
      Arith
      Lia
      List.
diff --git a/examples/extract-io/IO.v b/examples/extract-io/IO.v
index 325664ce..48ca6dcd 100644
--- a/examples/extract-io/IO.v
+++ b/examples/extract-io/IO.v
@@ -1,4 +1,4 @@
-From Coq Require Import Arith.
+From Stdlib Require Import Arith.
 From ITree Require Import ITree.
 Import ITreeNotations.
 
diff --git a/examples/extract-threads/ExtractThreadsExample.v b/examples/extract-threads/ExtractThreadsExample.v
index 440cae80..63c11a80 100644
--- a/examples/extract-threads/ExtractThreadsExample.v
+++ b/examples/extract-threads/ExtractThreadsExample.v
@@ -1,4 +1,4 @@
-From Coq Require ExtrOcamlBasic ExtrOcamlString.
+From Stdlib Require ExtrOcamlBasic ExtrOcamlString.
 
 From ITreeExamples Require Import MultiThreadedPrinting.
 
diff --git a/extra/Dijkstra/DelaySpecMonad.v b/extra/Dijkstra/DelaySpecMonad.v
index 46ee81b5..2393b03d 100644
--- a/extra/Dijkstra/DelaySpecMonad.v
+++ b/extra/Dijkstra/DelaySpecMonad.v
@@ -1,4 +1,4 @@
-From Coq Require Import
+From Stdlib Require Import
      Morphisms.
 
 From ExtLib Require Import
@@ -7,6 +7,7 @@ From ExtLib Require Import
 From ITree Require Import
      ITree
      ITreeFacts
+     HeterogeneousRelations
      Props.Infinite.
 
 From ITree.Extra Require Import
@@ -14,8 +15,6 @@ From ITree.Extra Require Import
      Dijkstra.PureITreeBasics
      Dijkstra.IterRel.
 
-From Paco Require Import paco.
-
 Import Monads.
 Import MonadNotation.
 
@@ -29,7 +28,7 @@ Ltac clear_ret_eutt_spin :=
   match goal with | H : ret ?a ≈ ITree.spin  |- _ => simpl in H; exfalso; eapply not_ret_eutt_spin; eauto
              | H : Ret ?a ≈ ITree.spin  |- _ => exfalso; eapply not_ret_eutt_spin; eauto
              | H : ITree.spin ≈ ret ?a  |- _ => exfalso; symmetry in H; eapply not_ret_eutt_spin; eauto
-             | H : any_infinite (ret _ ) |- _ => pinversion H
+             | H : any_infinite (ret _ ) |- _ => step in H; inv H
   end.
 
 Ltac invert_evidence :=
@@ -38,7 +37,6 @@ Ltac invert_evidence :=
                  | H : _ \/ _ |- _ => destruct H
                  | H : exists a : ?A, _ |- _ => destruct H as [?a ?H]
                  | x : ?A + ?B |- _ => destruct x as [?a | ?b]
-                 | H : upaco1 _ _ _ |- _ => pclearbot
                  end.
 
 Ltac invert_ret := simpl in *; match goal with | H : Ret ?a ≈ Ret ?b |- _ =>
@@ -114,7 +112,7 @@ Qed.
 Instance DelaySpecMonadLaws : MonadLawsE DelaySpec.
 Next Obligation.
   repeat red. cbn. split; intros; basic_solve; auto.
-  - pinversion H.
+  - repeat red in H; step in H; inv H. 
   - left. exists x. split; auto; reflexivity.
 Qed.
 Next Obligation.
@@ -122,7 +120,7 @@ Next Obligation.
   repeat red. cbn. split; intros.
   - red in H. simpl in H. destruct w as [w Hw]. simpl in *. eapply Hw; try apply H.
     intros. simpl in *. destruct p as [p Hp]. simpl in *. basic_solve.
-    + eapply Hp; eauto. symmetry. auto.
+    + eapply Hp; eauto. now rewrite <- H0. 
     + apply div_spin_eutt in H0. eapply Hp; eauto.
   - red. destruct w as [w Hw]. simpl in *. eapply Hw; try apply H. intros.
     destruct p as [p Hp]. simpl in *.
@@ -206,7 +204,7 @@ Notation "x =[ g ]=> y" := (iter_arrow_rel g x y) (at level 70) : delayspec_scop
 Lemma iter_inl_spin : forall (A B : Type) (g : A -> Delay (A + B) ) (a : A),
     not_wf_from (iter_arrow_rel g) a -> ITree.iter g a ≈ ITree.spin.
 Proof.
-  intros A B g. einit. ecofix CIH. intros. pinversion H0; try apply not_wf_F_mono'.
+  intros A B g. coinduction. intros. red in H; sinv H; try apply not_wf_F_mono'.
   setoid_rewrite unfold_iter_ktree. unfold iter_arrow_rel in Hrel. apply eutt_ret_euttge in Hrel.
   rewrite Hrel. rewrite bind_ret_l. rewrite unfold_spin. etau.
 Qed.
@@ -247,7 +245,7 @@ Lemma loop_invar : forall (A B : Type) (g : A -> Delay (A + B) ) (a : A)
                           (q : Delay (A + B) -> Prop) (Hq : resp_eutt q),
     (q -+> p) -> (q (g a)) ->
     (forall t, q t -> q (bind t (iter_lift g))) ->
-    (p \1/ any_infinite) (ITree.iter g a).
+    (Disj_unary _ p any_infinite) (ITree.iter g a).
 Proof.
   intros. unfold loop_invar_imp in *.
   set (iter_arrow_rel g) as rg.
diff --git a/extra/Dijkstra/ITreeDijkstra.v b/extra/Dijkstra/ITreeDijkstra.v
index 87fde1a2..a73cedbf 100644
--- a/extra/Dijkstra/ITreeDijkstra.v
+++ b/extra/Dijkstra/ITreeDijkstra.v
@@ -1,11 +1,11 @@
-From Coq Require Import
+From Coinduction Require Import all. 
+
+From Stdlib Require Import
      Morphisms.
 
 From ExtLib Require Import
      Structures.Monad.
 
-From Paco Require Import paco.
-
 From ITree Require Import
      Axioms
      ITree
@@ -24,6 +24,7 @@ Import MonadNotation.
 #[local] Open Scope monad_scope.
 #[local] Open Scope delayspec_scope.
 
+
 Section ITreeDijkstra.
 
   Context (E : Type -> Type).
@@ -38,7 +39,7 @@ Section ITreeDijkstra.
   Instance proper_itree_spec {R} {p : ITDInput R}: Proper (eutt eq ==> iff) (proj1_sig p).
   Proof.
     intros ? ? ?. destruct p as [p Hp]. simpl. split; intros; eapply Hp; eauto.
-    symmetry. auto.
+    now rewrite <- H.
   Qed.
 
   Program Definition bind_ex (A B: Type) (w: ITreeSpec A) (g : A -> ITreeSpec B) : ITreeSpec B :=
@@ -54,15 +55,18 @@ Section ITreeDijkstra.
       intros.
       specialize (noret_cast_nop H0) as Ht1.
       rewrite H in H0. specialize (noret_cast_nop H0) as Ht2.
-      eapply Hp; eauto.
-      symmetry in H.
-      eapply noret_cast_cast; eauto.
+      eapply Hp. 
+      clear Ht2. 
+      symmetry in H. 
+      eapply noret_cast_cast. all: eauto.
     - left. exists a. split; auto. rewrite H. auto.
     - right. rewrite H at 1. split; auto.
       destruct p as [p Hp]; simpl in *.
-      eapply Hp; eauto.
+      eapply Hp. 
+      symmetry in H. 
+      symmetry. 
       eapply noret_cast_cast; eauto.
-      rewrite H. auto.
+      auto. 
   Qed.
   Next Obligation.
   Proof.
@@ -99,7 +103,7 @@ Section ITreeDijkstra.
     (*bind_ret*)
     repeat red. cbn. intros. split; intros; basic_solve.
     - apply invert_ret in H. subst. auto.
-    - pinversion H.
+    - sinv H.
     - left. exists x. split; auto. constructor. reflexivity.
   Qed.
   Next Obligation.
@@ -193,15 +197,13 @@ Section ITreeDijkstra.
   Definition is_inf_ {A : Type} (F : stream A -> Prop) : stream A -> Prop :=
     fun s => is_infF F (observe_stream s).
 
-  Definition is_inf {A : Type} := paco1 (@is_inf_ A) bot1.
+  Lemma is_inf_mono {A} : Proper (leq ==> leq) (@is_inf_ A). 
+  Proof. monauto. Qed. 
 
-  Lemma is_inf_monot {A} : monotone1 (@is_inf_ A).
-  Proof.
-    red. intros. red in IN. red. induction IN; auto with itree.
-  Qed.
-
-  Hint Resolve is_inf_monot : paco.
+  Definition is_inf_mon A : mon (stream A -> Prop) := 
+  {| body := @is_inf_ A; Hbody := is_inf_mono |}. 
 
+  Definition is_inf {A : Type} := gfp (@is_inf_mon A).
 
   CoFixpoint app' {A : Type} (osl: stream' A) (sr : stream A) : stream A :=
     match osl with
@@ -221,48 +223,57 @@ Section ITreeDijkstra.
   Definition bisim_ {A : Type} (F : stream A -> stream A -> Prop) : stream A -> stream A -> Prop :=
     fun s1 s2 => bisimF F (observe_stream s1) (observe_stream s2).
 
-  Definition bisim {A : Type} := paco2 (@bisim_ A) bot2.
-
-  Lemma bisim_monot {A} : monotone2 (@bisim_ A).
-  Proof.
-    red. intros. red in IN. red. induction IN; auto with itree.
-  Qed.
+  Lemma bisim_mono {A} : Proper (leq ==> leq) (@bisim_ A). 
+  Proof. monauto. Qed. 
+  
+  Definition bisim_mon {A} : mon (stream A -> stream A -> Prop) := 
+  {| body := @bisim_ A ; Hbody := bisim_mono |}. 
 
-  Hint Resolve bisim_monot : paco.
+  Definition bisim {A : Type} := gfp (@bisim_mon A).
 
   Instance bisim_equiv {A} : Equivalence (@bisim A).
   Proof.
     constructor; red.
-    - pcofix CIH. intros. pfold. red. destruct (observe_stream x); auto with itree.
-    - pcofix CIH. intros.
-      pfold. red.
-      pinversion H0; subst; auto with itree.
-    - pcofix CIH. intros. pfold. red.
-      pinversion H0; pinversion H1; auto with itree.
+    - coinduction c CIH. intros. cbn; red. destruct (observe_stream x); auto with itree.
+    - coinduction c CIH. intros.
+      cbn; red.
+      red in H; sinv H; auto with itree.
+    - unfold bisim at 3. coinduction c CIH. intros. cbn; red.
+      red in H; sinv H; red in H0; sinv H0; auto with itree.
       + rewrite <- H in H3. discriminate.
-      + rewrite <- H2 in H5. discriminate.
-      + rewrite <- H2 in H4. injection H4; intros; subst.
-        constructor. right. eauto.
+      + rewrite <- H2 in H4. discriminate.
+      + rewrite <- H2 in H. injection H; intros; subst.
+        constructor. eauto.
    Qed.
 
+(* step notes: 
+step on elem should not reduce 
+step on mon can reduce 
+step on gfp can reduce. 
+*)
+
   Instance proper_bisim_app {A} : Proper (@bisim A ==> bisim ==> bisim) app.
   Proof.
-    repeat red. pcofix CIH.  intros s1 s2 H12 s3 s4 H34.
-    pfold. red. unfold app. pinversion H12.
-    - simpl. destruct s3. destruct s4. pinversion H34; simpl in *; subst; auto with itree.
-      constructor. left. apply pacobot2. auto.
-    - cbn. constructor. right. apply CIH; auto.
+     coinduction c CIH. intros s1 s2 H12 s3 s4 H34.
+     cbn; red. unfold app. sinv H12.
+    - simpl. destruct s3. destruct s4. sinv H34; simpl in *; subst; auto with itree.
+      constructor. now do 2 step. 
+    - cbn. constructor. apply CIH; auto.
   Qed.
 
-  Instance proper_bisim_inf_imp {A} : Proper (@bisim A ==> impl) is_inf.
+
+
+#[local] Tactic Notation "icbn" := repeat red; cbn.  
+
+  Instance proper_bisim_inf_imp {A} : Proper (@bisim A ==> Basics.impl) is_inf.
   Proof.
-    repeat red. pcofix CIH.
-    intros s1 s2 H12 H. pfold. red. punfold H. red in H.
-    punfold H12. red in H12. inversion H12; subst; auto.
-    - rewrite <- H1 in H. inversion H.
-    - inversion H. subst. pclearbot.
-      constructor. right. eapply CIH; eauto.
-      rewrite <- H3 in H0. injection H0 as H0 . subst. auto.
+    coinduction c CIH.
+    intros s1 s2 H12 H. icbn. step in H. 
+    step in H12. inv H12. 
+    - rewrite <- H1 in H. inv H.
+    - inversion H; subst. 
+      constructor. eapply CIH; eauto.
+      rewrite <- H3 in H0. inv H0.
   Qed.
 
   Instance proper_bisim_inf {A} : Proper (@bisim A ==> iff) (is_inf).
@@ -273,9 +284,9 @@ Section ITreeDijkstra.
 
   Lemma app_inf : forall (A : Type) (s1 s2 : stream A), is_inf s1 -> bisim (app s1 s2) s1.
   Proof.
-    intros A. pcofix CIH. intros s1 s2 Hinf. pfold. unfold app.
-    pinversion Hinf.
-    red. cbn. rewrite <- H. constructor. right. apply CIH; auto.
+    intros A. coinduction c CIH. intros s1 s2 Hinf. icbn. unfold app.
+    sinv Hinf.
+    cbn. constructor. apply CIH; auto.
   Qed.
 
   Variant forall_streamF {A : Type} (P : A -> Prop) (F : stream A -> Prop) : stream' A -> Prop :=
@@ -287,14 +298,12 @@ Section ITreeDijkstra.
   Definition forall_stream_ {A : Type} (P : A -> Prop) (F : stream A -> Prop) : stream A -> Prop :=
     fun s => forall_streamF P F (observe_stream s).
 
-  Lemma forall_stream_monot (A : Type) (P : A -> Prop) : monotone1 (forall_stream_ P).
-  Proof.
-    red. intros. red. red in IN. destruct IN; auto with itree.
-  Qed.
+  Lemma forall_stream_mono (A : Type) (P : A -> Prop) : Proper (leq ==> leq) (forall_stream_ P).
+  Proof. monauto. Qed.
 
-  Hint Resolve forall_stream_monot : paco.
+  Definition forall_stream_mon A P := Build_mon (forall_stream_mono A P). 
 
-  Definition forall_stream {A : Type} (P : A -> Prop) := paco1 (forall_stream_ P) bot1.
+  Definition forall_stream {A : Type} (P : A -> Prop) := gfp (forall_stream_mon A P).
 
   Inductive inf_manyF {A : Type} (P : A -> Prop) (F : stream A -> Prop) : stream' A -> Prop :=
     | cons_search (h : A) (t : stream A) : inf_manyF P F (observe_stream t) -> inf_manyF P F (ConsF h t)
@@ -306,33 +315,31 @@ Section ITreeDijkstra.
   Definition inf_many_ {A : Type} (P : A -> Prop) (F : stream A -> Prop) : stream A -> Prop :=
     fun s => inf_manyF P F (observe_stream s).
 
-  Lemma inf_many_monot (A : Type) (P : A -> Prop) : monotone1 (inf_many_ P).
-  Proof.
-    red. intros. red in IN. red. induction IN; auto with itree.
-  Qed.
+  Lemma inf_many_mono (A : Type) (P : A -> Prop) : Proper (leq ==> leq) (inf_many_ P).
+  Proof. monauto. Qed.
 
-  Hint Resolve inf_many_monot : paco.
+  Definition inf_many_mon A P := Build_mon (inf_many_mono A P). 
 
-  Definition inf_many {A : Type} (P : A -> Prop) := paco1 (inf_many_ P) bot1.
+  Definition inf_many {A : Type} (P : A -> Prop) := gfp (inf_many_mon A P).
 
   Lemma inf_many_inf : forall (A : Type) (P : A -> Prop) (s : stream A),
       inf_many P s -> is_inf s.
   Proof.
-    intros A P. pcofix CIH. intros s Him.
-    punfold Him. red in Him. pfold. red.
-    induction Him; auto with itree. pclearbot.
-    auto with itree.
+    intros A P. coinduction c CIH. intros s Him.
+    step in Him. icbn. 
+    induction Him; auto with itree.
+    constructor. apply CIH. now step. 
   Qed.
 
   Lemma inf_and_forall : forall (A : Type) (P : A -> Prop) (s : stream A),
       is_inf s -> forall_stream P s -> inf_many P s.
   Proof.
-    intros A P. pcofix CIH. intros s Hinf Hforall.
-    pfold. red. punfold Hinf. red in Hinf. punfold Hforall.
-    red in Hforall. inversion Hinf.
-    inversion Hforall.
+    intros A P. coinduction c CIH. intros s Hinf Hforall.
+    icbn. step in Hinf. step in Hforall.
+    inv Hinf.
+    inv Hforall.
     - rewrite <- H in H2. discriminate.
-    - pclearbot. rewrite <- H in H1. injection H1 as H1. subst.
+    - rewrite <- H in H1. inv H1.
       apply cons_found; auto.
   Qed.
 
@@ -341,7 +348,6 @@ Section ITreeDijkstra.
   (*need a way to relate trees across event types if they never use it*)
 
   Definition rel_eventless {E1 E2 R} (t1 : itree E1 R) (t2 : itree E2 R) : Prop := False.
-
   Inductive eqitEF {E1 E2 : Type -> Type} {R1 R2 : Type} (RR : R1 -> R2 -> Prop)
             (sim : itree E1 R1 -> itree E2 R2 -> Prop) : itree' E1 R1 -> itree' E2 R2 -> Prop :=
     | EqERet : forall r1 r2, RR r1 r2 -> eqitEF RR sim (RetF r1) (RetF r2)
@@ -362,15 +368,12 @@ Section ITreeDijkstra.
              (t1 : itree E1 R1) (t2 : itree E2 R2)
     := eqitEF RR sim (observe t1) (observe t2).
 
-  Definition eqitE {E1 E2} {R1 R2} RR := paco2 (eqitE_ E1 E2 R1 R2 RR) bot2.
+  Lemma eqitE_mono {E1 E2 R1 R2 RR} : Proper (leq ==> leq)  (@eqitE_ E1 E2 R1 R2 RR).
+    Proof. monauto. Qed.
 
-  Lemma eqitE_monot {E1 E2 R1 R2 RR} : monotone2  (@eqitE_ E1 E2 R1 R2 RR).
-  Proof.
-    repeat red. intros. rename x0 into t1. rename x1 into t2.
-    induction IN; eauto with itree.
-  Qed.
+  Definition eqitE_mon {E1 E2 R1 R2 RR} := Build_mon (@eqitE_mono E1 E2 R1 R2 RR).
 
-  Hint Resolve eqitE_monot : paco.
+  Definition eqitE {E1 E2} {R1 R2} RR := gfp (@eqitE_mon E1 E2 R1 R2 RR).
 
   Definition equivE {E1 E2} {R} : itree E1 R -> itree E2 R -> Prop := eqitE eq.
 
@@ -384,35 +387,30 @@ Section ITreeDijkstra.
     : itree E R -> Prop := fun t => eventlessF F (observe t).
 
   Hint Unfold eventless_ : itree.
+  
+  Lemma eventless_mono {E1 R} : Proper (leq ==> leq) (@eventless_ E1 R).
+  Proof. monauto. Qed.
 
-  Definition eventless {E : Type -> Type} {R : Type} : itree E R -> Prop :=
-    paco1 (eventless_) bot1.
-
-  Lemma eventless_monot {E1 R} : monotone1 (@eventless_ E1 R).
-  Proof.
-    red. intros. red in IN. red. inversion IN; auto with itree.
-  Qed.
+  Definition eventless_mon {E1 R} := Build_mon (@eventless_mono E1 R).
 
-  Hint Resolve eventless_monot : paco.
+  Definition eventless {E : Type -> Type} {R : Type} : itree E R -> Prop :=
+    gfp (@eventless_mon E R).
 
-  Instance proper_eventless_imp {E1 R} : Proper (eutt eq ==> impl) (@eventless E1 R) .
+  Instance proper_eventless_imp {E1 R} : Proper (eutt eq ==> Basics.impl) (@eventless E1 R) .
   Proof.
-    repeat red. pcofix CIH.
+    repeat red. coinduction c CIH.
     intros t1 t2 Heutt Hev.
-    pfold. punfold Heutt.  red.
-    unfold_eqit. assert (Hev' : eventless t1); auto. punfold Hev.
+    step in Heutt. icbn.
+    assert (Hev' := Hev). step in Hev.
     dependent induction Heutt; subst; auto with itree.
-    - rewrite <- x. auto with itree.
-    - rewrite <- x. constructor. right. eapply CIH; eauto.
-      specialize (itree_eta t1) as Ht1. rewrite <- x0 in Ht1.
-      rewrite Ht1. rewrite tau_eutt. pclearbot. auto.
-    - red in Hev. inversion Hev; subst.
-      + rewrite <- H0 in x0. discriminate.
-      + rewrite <- H in x0. discriminate.
-    - red in Hev. rewrite <- x in Hev. inversion Hev; subst.
-      pclearbot. eapply IHHeutt; try apply H0; eauto. red.
-      punfold H0.
-    - rewrite <- x. constructor. right. eapply CIH; eauto with itree.
+    - simpobs. auto with itree.
+    - simpobs. constructor. eapply CIH; eauto.
+      inv Hev. 
+    - simpobs. inv Hev. 
+    - simpobs. inv Hev.
+      eapply IHHeutt; try apply H0; eauto.
+      now step in H0. 
+    - simpobs. constructor. unstep in Heutt. eapply CIH; eauto with itree.
   Qed.
 
   Instance proper_eventless {E1 R} : Proper (eutt eq ==> iff) (@eventless E1 R).
@@ -426,42 +424,38 @@ Section ITreeDijkstra.
                  (t1 : itree E1 R1) (t2 : itree E1 R2),
       eventless t1 -> eutt RR t1 t2 -> eqitE RR t1 t2.
   Proof.
-    intros E1 R1 R2 RR. pcofix CIH. intros.
-    punfold H1. unfold_eqit. pfold. red. dependent induction H1; auto.
-    - rewrite <- x0. rewrite <- x. constructor. auto.
-    - rewrite <- x0. rewrite <- x.
-      constructor. right.
+    intros E1 R1 R2 RR. coinduction c CIH. intros.
+    step in H0. icbn. dependent induction H0; auto.
+    - simpobs. eret. 
+    - simpobs.
+      constructor.  
       specialize (itree_eta t1) as Ht1. specialize (itree_eta t2) as Ht2.
-      rewrite <- x0 in Ht1. rewrite <- x in Ht2.
+      simpobs. 
       assert (t1 ≈ m1). { rewrite Ht1. rewrite tau_eutt. reflexivity. }
       assert (t2 ≈ m2). { rewrite Ht2. rewrite tau_eutt. reflexivity. }
-      pclearbot.
       apply CIH; auto.
-      rewrite <- H. auto.
-    - exfalso. pinversion H0.
-      + rewrite <- H1 in x0. discriminate.
-      + rewrite <- H in x0. discriminate.
-    - rewrite <- x. constructor.
-      specialize (itree_eta t1) as Ht1. rewrite <- x in Ht1.
-      rewrite Ht1 in H0. pinversion H0.
-      subst. eapply IHeqitF; try apply H2; eauto.
-    - rewrite <- x. constructor. eapply IHeqitF; eauto.
+      now rewrite <- H0. 
+    - exfalso. step in H; simpobs. inv H.
+    - simpobs. constructor.
+      specialize (itree_eta t1) as Ht1. simpobs. 
+      sinv H. 
+      + simpobs; easy.  
+      + eapply IHeqitF; eauto. rewrite <- tau_eutt. step. 
+      rewrite x, <- H1. now constructor. 
+    - simpobs. constructor. eapply IHeqitF; eauto.
   Qed.
 
   Lemma eventless_div : forall (R : Type) (t : itree E R),
       eventless t -> all_infinite t -> t ≈ ITree.spin.
   Proof.
-    intros R. pcofix CIH. intros.
-    pinversion H0.
-    - specialize (itree_eta t) as Ht. rewrite <- H2 in Ht.
-      rewrite Ht in H1. pinversion H1.
-    - pfold. red. cbn. rewrite <- H.
-      red in H0. rewrite <- H in H0.
+    intros R. coinduction c CIH. intros.
+      sinv H.
+    - specialize (itree_eta t) as Ht. simpobs. 
+      rewrite Ht in H0. sinv H0.
+    - icbn. simpobs. 
+      red in H0. step in H0; simpobs; inv H0. 
       constructor.
-      right. apply CIH; auto.
-      specialize (itree_eta t) as Ht. rewrite <- H in Ht.
-      rewrite Ht in H1. punfold H1. red in H1. cbn in H1.
-      inversion H1. subst. pclearbot. auto.
+      apply CIH; auto. 
   Qed.
 
   Lemma eventless_ret : forall (R : Type) (t : itree E R) (r : R),
@@ -469,17 +463,16 @@ Section ITreeDijkstra.
   Proof.
     intros R t r.
     intros. induction H0; auto. rewrite H0 in H.
-    pinversion H.
+    sinv H.
   Qed.
 
   Lemma eqitE_imp_eutt : forall (E : Type -> Type) (R1 R2 : Type) (RR : R1 -> R2 -> Prop)
                                 (t1 : itree E R1) (t2 : itree E R2),
       eqitE RR t1 t2 -> eutt RR t1 t2.
   Proof.
-    intros E1 R1 R2 RR. pcofix CIH.
-    intros t1 t2 Heq. pfold. punfold Heq.
-    red. red in Heq. induction Heq; auto with itree.
-    pclearbot. constructor. right. apply CIH. auto.
+    intros E1 R1 R2 RR. coinduction c CIH.
+    intros t1 t2 Heq. icbn. step in Heq. 
+    induction Heq; auto with itree.
   Qed.
 
   Lemma eqitE_imp_eventlessl : forall (E1 E2 : Type -> Type) (R1 R2 : Type)
@@ -487,11 +480,10 @@ Section ITreeDijkstra.
                                       (t1 : itree E1 R1) (t2 : itree E2 R2),
       eqitE RR t1 t2 -> eventless t1.
   Proof.
-    intros E1 E2 R1 R2 RR. pcofix CIH.
-    intros. punfold H0. red in H0.
-    pfold. red. induction H0; eauto with itree.
-    pclearbot.
-    constructor. right. eapply CIH; eauto.
+    intros E1 E2 R1 R2 RR. coinduction c CIH.
+    intros. step in H. 
+    icbn. induction H; eauto with itree.
+    constructor. apply (CIH t0 (ITreeDefinition.go ot2)). now step. 
   Qed.
 
   Lemma eqitE_imp_eventlessr : forall (E1 E2 : Type -> Type) (R1 R2 : Type)
@@ -499,18 +491,17 @@ Section ITreeDijkstra.
                                       (t1 : itree E1 R1) (t2 : itree E2 R2),
       eqitE RR t1 t2 -> eventless t2.
   Proof.
-    intros E1 E2 R1 R2 RR. pcofix CIH.
-    intros. punfold H0. red in H0.
-    pfold. red. induction H0; eauto with itree.
-    pclearbot.
-    constructor. right. eapply CIH; eauto.
+    intros E1 E2 R1 R2 RR. coinduction c CIH.
+    intros. step in H.
+    icbn. induction H; eauto with itree.
+    constructor. apply (CIH (ITreeDefinition.go ot1) t0). now step. 
   Qed.
 
   Lemma eventless_spin : forall (E1 : Type -> Type) (R : Type),
       eventless (@ITree.spin E1 R).
   Proof.
-    intros E1 R. pcofix CIH. pfold. red. cbn. constructor.
-    right. auto.
+    intros E1 R. coinduction c CIH. icbn. cbn. constructor.
+    auto.
   Qed.
 
   CoFixpoint remove_events' {E1 E2 : Type -> Type} {A : Type}
@@ -527,10 +518,10 @@ Section ITreeDijkstra.
                                          (t : itree E1 A),
       eventless t -> @equivE E1 E2 A t (remove_events t).
   Proof.
-    intros E1 E2 A. pcofix CIH. intros.
-    pfold. red. pinversion H0.
+    intros E1 E2 A. coinduction c CIH. intros.
+    icbn. sinv H.
     - cbn. unfold remove_events. rewrite <- H1. cbn. auto with itree.
-    - unfold remove_events. rewrite <- H. cbn. constructor. right. apply CIH.
+    - unfold remove_events. rewrite <- H0. cbn. constructor. apply CIH.
       auto.
   Qed.
 
@@ -538,54 +529,62 @@ Section ITreeDijkstra.
                                          (t : itree E1 A),
       eventless (@remove_events E1 E2 A t).
   Proof.
-    intros E1 E2 A. pcofix CIH. intros.
-    pfold. red. unfold remove_events. destruct (observe t) eqn : Heq.
+    intros E1 E2 A. coinduction c CIH. intros.
+    icbn. unfold remove_events. destruct (observe t) eqn : Heq.
     - cbn. constructor.
-    - cbn. constructor. right. apply CIH.
-    - cbn. constructor. left. apply pacobot1, eventless_spin.
+    - cbn. constructor. apply CIH.
+    - cbn. constructor. do 2 step. apply eventless_spin. 
   Qed.
 
   Lemma delay_eventless : forall (A : Type) (d : Delay A),
       eventless d.
   Proof.
-    intros A. pcofix CIH. intros.
-    pfold. red. destruct (observe d); auto with itree.
+    intros A. coinduction c CIH. intros.
+    icbn. destruct (observe d); auto with itree.
     destruct e.
   Qed.
 
-  (* TODO need to get this done at some point*)
   Lemma eqitE_inv_Tau : forall (E1 E2 : Type -> Type) (R1 R2 : Type) (RR : R1 -> R2 -> Prop)
             (t1 : itree E1 R1) (t2 : itree E2 R2),
             eqitE RR (Tau t1) (Tau t2) -> eqitE RR t1 t2.
   Proof.
     intros E1 E2 R1 R2 RR.
 
-    pcofix CIH. intros.
-    punfold H0. red in H0. simpl in H0.
-    pfold. red. remember (TauF t1) as tt1.
-    remember (TauF t2) as tt2. genobs t1 ot1.
-    genobs t2 ot2. induction H0; try discriminate.
-    - pclearbot. injection Heqtt1 as Heqtt1. injection Heqtt2 as Heqtt2. subst.
-      punfold H. red in H. auto. eapply eqitE_monot; eauto.
-      intros. pclearbot. left. eapply paco2_mon; try apply PR. intros. contradiction.
-   Abort.
+    coinduction c CIH. intros. icbn. 
+    intros.
+    step in H. 
+    remember (TauF t1) as ot1. 
+    remember (TauF t2) as ot2. 
+    revert t1 t2 Heqot1 Heqot2. cbn in H. 
+    induction H; intros t1' t2' Heqot1 Heqot2; try easy; subst.
+    - inv Heqot1; inv Heqot2. now step.  
+    - inv H; inv Heqot1; simpobs. 
+      + constructor. now apply IHeqitEF. 
+      + constructor. now apply IHeqitEF.
+      + now do 2 step. 
+    - inv H; inv Heqot2; simpobs. 
+      + constructor. now apply IHeqitEF. 
+      + now do 2 step. 
+      + constructor. now apply IHeqitEF. 
+  Qed. 
+
 
   Lemma inv_remove_events : forall (E1 E2 : Type -> Type) (R : Type)
                                    (t1 : itree E1 R) (t2 : itree E2 R),
       eventless t1 -> eventless t2 -> @remove_events E1 E2 R t1 ≈ @remove_events E2 E2 R t2 ->
       equivE t1 t2.
   Proof.
-    intros E1 E2 R. pcofix CIH.
-    intros t1 t2 Hev1 Hev2 Heutt. pfold. red.
-    punfold Heutt. unfold_eqit. dependent induction Heutt; subst.
+    intros E1 E2 R. coinduction c CIH.
+    intros t1 t2 Hev1 Hev2 Heutt. icbn.
+    step in Heutt. dependent induction Heutt; subst.
     - unfold remove_events in x0, x.
       destruct (observe t1); destruct (observe t2); try discriminate.
-      constructor. cbn in *. injection x0. injection x. intros. subst. auto.
+      constructor. cbn in *. inv x0; inv x. 
     - unfold remove_events in x0, x.
       destruct (observe t1) eqn : Heq1; destruct (observe t2) eqn : Heq2; try discriminate.
       + cbn in *. constructor.
-        injection x0. injection x. intros. subst. pclearbot.
-        right. apply CIH; auto.
+        inv x0. inv x. intros.  
+        apply CIH; auto.
         * specialize (itree_eta t1) as Ht1. rewrite Heq1 in Ht1.
           assert (t ≈ t1).
           { rewrite Ht1. rewrite tau_eutt. reflexivity. }
@@ -594,13 +593,13 @@ Section ITreeDijkstra.
           assert (t0 ≈ t2).
           { rewrite Ht2. rewrite tau_eutt. reflexivity. }
           rewrite H. auto.
-      + pinversion Hev2.
+      + sinv Hev2.
         * rewrite Heq2 in H0. discriminate.
         * rewrite Heq2 in H. discriminate.
-      + pinversion Hev1.
+      + sinv Hev1.
         * rewrite Heq1 in H0. discriminate.
         * rewrite Heq1 in H. discriminate.
-      + pinversion Hev1.
+      + sinv Hev1.
         * rewrite Heq1 in H0. discriminate.
         * rewrite Heq1 in H. discriminate.
     - unfold remove_events in *. destruct (observe t1); cbn in x0; discriminate.
@@ -613,7 +612,7 @@ Section ITreeDijkstra.
            rewrite  H. auto.
         * unfold remove_events. rewrite x. auto.
       + exfalso. specialize (itree_eta t1) as Ht1. rewrite Heq in Ht1.
-        rewrite Ht1 in Hev1. pinversion Hev1.
+        rewrite Ht1 in Hev1. sinv Hev1.
     - unfold remove_events in x. destruct (observe t2) eqn : Heq; cbn in *; try discriminate.
       + injection x as x. constructor.
         apply IHHeutt; auto.
@@ -623,7 +622,7 @@ Section ITreeDijkstra.
           rewrite H. auto.
         * unfold remove_events. rewrite x. auto.
       + exfalso. specialize (itree_eta t2) as Ht2. rewrite Heq in Ht2.
-        rewrite Ht2 in Hev2. pinversion Hev2.
+        rewrite Ht2 in Hev2. sinv Hev2.
   Qed.
 
   Lemma remove_events_eqitE : forall (E1 E2 E3 E4 : Type -> Type) (R1 R2 : Type)
@@ -631,10 +630,10 @@ Section ITreeDijkstra.
                                       (t1 : itree E1 R1) (t2 : itree E2 R2),
       eqitE RR t1 t2 -> eqitE RR (@remove_events E1 E3 R1 t1) (@remove_events E2 E4 R2 t2).
   Proof.
-    intros E1 E2 E3 E4 R1 R2 RR. pcofix CIH. intros.
-    punfold H0. red in H0. pfold. red. unfold remove_events.
-    induction H0; cbn; auto with itree.
-    pclearbot. constructor. right. apply CIH; auto.
+    intros E1 E2 E3 E4 R1 R2 RR. coinduction c CIH. intros.
+    step in H. icbn. unfold remove_events.
+    induction H; cbn; auto with itree.
+    constructor. apply CIH; auto.
   Qed.
 
   Lemma eqitE_trans : forall (E1 E2 E3 : Type -> Type) (R : Type)
@@ -664,14 +663,13 @@ Section ITreeDijkstra.
                             (t1 : itree E1 R) (t2 : itree E2 R),
       equivE t1 t2 -> equivE t2 t1.
   Proof.
-    intros E1 E2 R. pcofix CIH. intros.
-    punfold H0. red in H0. pfold. red.
-    induction H0; eauto with itree.
-    pclearbot. constructor. right. apply CIH; auto.
+    intros E1 E2 R. coinduction c CIH. intros.
+    step in H. icbn. 
+    induction H; eauto with itree.
   Qed.
 
 
-  Instance proper_eutt_equivE_imp {E1 E2} {R} : Proper (eutt eq ==> (eutt eq) ==> impl) (@equivE E1 E2 R).
+  Instance proper_eutt_equivE_imp {E1 E2} {R} : Proper (eutt eq ==> (eutt eq) ==> Basics.impl) (@equivE E1 E2 R).
   Proof.
     intros t1 t2 Ht12 t3 t4 Ht34. intro.
     apply eqitE_imp_eventlessl in H as Ht1.
@@ -697,7 +695,7 @@ Section ITreeDijkstra.
 
   (*could also use an eventless predicate*)
 
-  (*gets the idea across, obviously I want to pacoize this*)
+
   (*this is a key part of an effect observation from *)
   CoInductive itree_includes' {R : Type} : itree E R -> stream Ev -> Delay R -> Prop :=
     | includes_base (t : itree E R) (d : Delay R) : equivE t d -> itree_includes' t Nil d
@@ -712,8 +710,15 @@ Section ITreeDijkstra.
         Vis e k ≈ t ->
         F (k a) s d -> itree_includesF F t (Cons (ev A e a) s) (Tau d).
 
+  Hint Constructors itree_includesF : itree. 
+
+  Lemma itree_includes_mono {R} : Proper (leq ==> leq) (@itree_includesF R).
+  Proof. monauto. Qed. 
+
+  Definition itree_includes_mon {R} := Build_mon (@itree_includes_mono R).   
+
   Definition itree_includes {R : Type} : itree E R -> stream Ev -> Delay R -> Prop :=
-    paco3 (@itree_includesF R) bot3.
+    gfp (@itree_includes_mon R).
 
 End ITreeDijkstra.
 
@@ -753,7 +758,7 @@ Section RetBindCounter.
          *)
 
   Program Definition w : ITreeSpec Sound unit := fun p => p (Vis Ring (fun _ => Ret tt) ).
-  (*This proof is hideous for a few reasons but it is a good start,
+  (* This proof is hideous for a few reasons but it is a good start,
     and great confirmation that our whole IBranch excursion wasn't a
     soul crushing waste of time
    *)
@@ -766,9 +771,9 @@ Section RetBindCounter.
       unfold p. cbn. reflexivity.
     }
     apply Hcontra in H. clear Hcontra. basic_solve.
-    - unfold p in H0. cbn in H0. pinversion H0.
-    - clear H0. pinversion H; try apply all_infiniteF_mono'. ddestruction.
-      specialize (H1 tt). punfold H1; try apply all_infiniteF_mono'.
+    - unfold p in H0. cbn in H0. sinv H0.
+    - clear H0. sinv H; try apply all_infiniteF_mono'. ddestruction.
+      specialize (H1 tt). step in H1; try apply all_infiniteF_mono'.
       inv H1.
   Qed.
 
diff --git a/extra/Dijkstra/IterRel.v b/extra/Dijkstra/IterRel.v
index 40b22380..33255f5a 100644
--- a/extra/Dijkstra/IterRel.v
+++ b/extra/Dijkstra/IterRel.v
@@ -1,7 +1,10 @@
-From Coq Require Import Arith Lia.
-From Paco Require Import paco.
+From Stdlib Require Import Arith Lia.
+From Coinduction Require Import all. 
 
-From ITree Require Import Axioms.
+From ITree Require Import 
+Axioms
+Eq.Eqit
+Utils. 
 
 Create HintDb not_wf.
 
@@ -17,21 +20,14 @@ Section IterRel.
     | not_wf (a' : A) (Hrel : r a a') (Hcorec : F a') .
   Hint Constructors not_wf_F : not_wf.
 
-  Lemma not_wf_F_mono sim sim' a
-        (IN : not_wf_F sim a)
-        (LE : sim <1= sim') : not_wf_F sim' a.
-  Proof.
-    destruct IN. eauto with not_wf.
-  Qed.
+  Lemma not_wf_F_mono : Proper (leq ==> leq) not_wf_F. 
+  Proof. monauto. Qed.
 
-  Lemma not_wf_F_mono' : monotone1 not_wf_F.
-  Proof.
-    red. intros. eapply not_wf_F_mono; eauto.
-  Qed.
-  Hint Resolve not_wf_F_mono' : paco.
+Definition not_wf_F_mon := 
+{| body := not_wf_F ; Hbody := not_wf_F_mono |}.
 
   Definition not_wf_from : A -> Prop :=
-    paco1 not_wf_F bot1.
+    gfp not_wf_F_mon.
 
   Inductive wf_from (a : A) : Prop :=
     | base : (forall a', ~ (r a a')) -> wf_from a
@@ -41,25 +37,25 @@ Section IterRel.
   Lemma neg_wf_from_not_wf_from_l : forall (a : A),
       ~(wf_from a) -> not_wf_from a.
   Proof.
-    pcofix CIH. intros. pfold. destruct (classic (exists a', r a a' /\ ~ ( wf_from a') )).
-    - destruct H as [a' [Hr Hwf] ]. econstructor; eauto.
+      coinduction c CIH. intros. destruct (classic (exists a', r a a' /\ ~ ( wf_from a') )).
+    - destruct H0 as [a' [Hr Hwf] ]. econstructor; eauto.
     - assert (forall a', ~ r a a' \/ wf_from a').
       {
         intros.
         destruct (classic (r a a')); auto. destruct (classic (wf_from a')); auto.
-        exfalso. apply H. exists a'. auto.
+        exfalso. apply H0. exists a'. auto.
       }
-      clear H.
-      exfalso. apply H0. clear H0. apply step. intros. destruct (H1 a'); auto with not_wf.
+      clear H0.
+      exfalso. apply H. clear H. apply step. intros. destruct (H1 a'); auto with not_wf.
   Qed.
 
   Lemma neg_wf_from_not_wf_from_r : forall (a : A),
       not_wf_from a -> ~ (wf_from a).
-  Proof.
-    intros. intro Hcontra. punfold H.  inversion H. pclearbot. clear H. generalize dependent a'.
+      Proof.
+      intros. intro Hcontra. repeat red in H. step in H. inversion H. clear H. generalize dependent a'.
     induction Hcontra; intros.
     - apply H in Hrel. auto.
-    - punfold Hcorec. inversion Hcorec. pclearbot. specialize (H0 a' Hrel a'0 Hrel0).
+    - step in Hcorec. inversion Hcorec. specialize (H0 a' Hrel a'0 Hrel0).
       auto.
   Qed.
 
@@ -79,10 +75,12 @@ Section IterRel.
     P a -> (forall a1 a2, P a1 -> r a1 a2 -> P a2 ) -> (forall a, P a -> r a (f a)) ->
     not_wf_from a.
   Proof.
-    intros. generalize dependent a. pcofix CIH. intros. pfold.
+    intros. generalize dependent a. unfold not_wf_from.
+    coinduction c CIH. 
+    intros. 
     apply not_wf with (a' := f a).
     - auto using H1.
-    - right. apply CIH. eapply H0; eauto.
+    - apply CIH. eapply H0; eauto.
   Qed.
 
   Lemma intro_wf : forall (P : A-> Prop) (m : A -> nat) (a : A),
@@ -122,10 +120,10 @@ Qed.
 Lemma wf_from_gt : forall (n : nat), wf_from (fun n0 n1 => n0 > n1) n.
 Proof.
   intros.
-  enough (forall n', n' <= n -> wf_from (fun n0 n1 => n0 > n1) n' ); auto.
+  enough (forall n', le n' n -> wf_from (fun n0 n1 => n0 > n1) n' ); auto.
   induction n; intros.
   - assert (n' = 0); try lia. subst. apply base. intros. lia.
-  - apply step. intros n'' Hn''. assert (n'' <= n); try lia. auto.
+  - apply step. intros n'' Hn''. assert (le n'' n); try lia. auto.
 Qed.
 (*induct on f a*)
 Lemma no_inf_dec_seq_aux : forall  (r : nat -> nat -> Prop) (n: nat),
@@ -146,7 +144,7 @@ Proof.
   intros A r f inv a Hinv Hgt Ha.
   remember (f a) as n0.
   generalize dependent a.
-  enough (forall a, f a <= n0 -> inv a -> wf_from r a).
+  enough (forall a, le (f a) n0 -> inv a -> wf_from r a).
   {
     intros. apply H. lia. auto.
   }
diff --git a/extra/Dijkstra/PureITreeBasics.v b/extra/Dijkstra/PureITreeBasics.v
index 8aeea503..7b53dd0e 100644
--- a/extra/Dijkstra/PureITreeBasics.v
+++ b/extra/Dijkstra/PureITreeBasics.v
@@ -1,11 +1,9 @@
-From Coq Require Import
+From Stdlib Require Import
      Morphisms.
 
 From ExtLib Require Import
      Structures.Monad.
 
-From Paco Require Import paco.
-
 From ITree Require Import
      Axioms
      ITree
@@ -23,11 +21,15 @@ Set Implicit Arguments.
 (** The itree Tau (Tau (Tau ...))*)
 #[local] Notation spin := ITree.spin.
 
+#[local] Tactic Notation "step" := repeat red; step. 
+#[local] Tactic Notation "step" "in" ident(h) := repeat red in h; step in h. 
+#[local] Tactic Notation "sinv" ident(h) := step in h; inv h. 
+
 (*this implies that if a spec w accepts spin, then bind w f should too?   *)
 Lemma spin_bind : forall (E : Type -> Type) (A B : Type) (f : A -> itree E B), spin ≈ ITree.bind spin f.
 Proof.
-  intros. pcofix CIH. pfold. unfold bind. simpl. red.
-  cbn. constructor. right. auto.
+  intros. coinduction. simpl.
+  now constructor.
 Qed.
 
 (*Depreacated predicate on itree predicates. Intended to denote that a predicate is invariant wrt adding
@@ -49,23 +51,25 @@ Lemma tau_invar_resp_eutt1: forall (E : Type -> Type) (A : Type) (P : itree E A
 (*spin is the only divergent itree with the void1 event type,*)
 Lemma div_spin_eutt : forall (A : Type) (t : itree void1 A), any_infinite t -> t ≈ spin.
 Proof.
-  intros A. pcofix CIH. intros. pfold. red. cbn.
+  intros A. coinduction. intros. cbn.
   destruct (observe t) eqn : Heqt.
-  - specialize (itree_eta t) as H. rewrite Heqt in H. rewrite H in H0. pinversion H0.
-  - constructor. right. apply CIH. specialize (itree_eta t) as H. rewrite Heqt in H.
+  - specialize (itree_eta t) as Heta. rewrite Heqt in Heta. rewrite Heta in H. sinv H. 
+  - constructor. apply CIH. specialize (itree_eta t) as Heta. rewrite Heqt in Heta.
     assert (t ≈ Tau t0).
-    + rewrite H. reflexivity.
-    + rewrite <- tau_eutt. rewrite <- H1. auto.
+    + rewrite Heta. reflexivity.
+    + rewrite <- tau_eutt. rewrite <- H0. auto.
   - destruct e.
 Qed.
 
 Lemma eutt_reta_or_div_aux : forall A (t : itree void1 A), ~(exists a, ret a ≈ t) -> any_infinite t.
 Proof.
-  intro A. pcofix CIH. pfold. unfold any_infinite_. intros. destruct (observe t) eqn : Heqt.
-  - exfalso. specialize (itree_eta t) as H. rewrite Heqt in H. apply H0.
-    exists r0. rewrite H. reflexivity.
-  - constructor. right. eapply CIH; eauto. intro. apply H0.
-    destruct H as [a Ha]. exists a. specialize (itree_eta t) as Ht. rewrite Heqt in Ht.
+  intro A. unfold any_infinite, any_infinite_. 
+  coinduction c CIH. 
+  intros. destruct (observe t) eqn : Heqt.
+  - exfalso. specialize (itree_eta t) as Heta. rewrite Heqt in Heta. apply H.
+    exists r. rewrite Heta. reflexivity.
+  - repeat red; simpobs; constructor. eapply CIH; eauto. intro. apply H.
+    destruct H0 as [a Ha]. exists a. specialize (itree_eta t) as Ht. rewrite Heqt in Ht.
     rewrite Ht. rewrite tau_eutt. auto.
   - destruct e.
 Qed.
@@ -79,7 +83,7 @@ Qed.
 
 Lemma ret_not_div : forall (A : Type) (E : Type -> Type) (a : A), ~ (@any_infinite E A (ret a)).
 Proof.
-  intros. intro Hcontra. pinversion Hcontra.
+  intros. intro Hcontra. sinv Hcontra. 
 Qed.
 
 Lemma not_ret_eutt_spin : forall A E (a : A), ~ (Ret a ≈ @spin E A).
@@ -91,20 +95,18 @@ Qed.
 Lemma eutt_ret_euttge : forall (E : Type -> Type) (A : Type) (a : A) (t : itree E A),
       t ≈ Ret a -> t ≳ Ret a.
 Proof.
-  intros. generalize dependent t. pcofix CIH. intros. pfold. red. pinversion H0; subst; auto.
-  - cbn. auto with itree.
-  - cbn. apply EqTauL; auto.
-    genobs t1 ot1. genobs (go (@RetF E A _ a)) ot2.  clear H1.
-    generalize dependent t1. generalize dependent t.
-    induction REL; intros; subst; auto; try discriminate.
-    + constructor. inversion Heqot2. auto.
-    + constructor; auto. eapply IHREL; eauto.
+  intros. generalize dependent t. icoinduction c CIH. intros. sinv H. 
+  - taul. 
+  (* Unset Printing Notations.  *)
+    remember (observe (Ret a)).
+    induction REL; try easy. 
+    + eret. 
+    + taul. now apply IHREL.  
 Qed.
 
 Lemma unfold_spin : forall (E : Type -> Type) (A : Type), (@spin E A) ≅ Tau spin.
 Proof.
-  intros.  pcofix CIH. cbn. pfold. red. cbn. apply EqTau. cbn.
-  left. pcofix CIH'. pfold. red. cbn. auto with itree.
+  intros. step. cbn. reflexivity. 
 Qed.
 
 Lemma burn_eutt_r : forall (A : Type) (t t' : itree void1 A) (n : nat), t≈ t' -> burn n t ≈ t'.
diff --git a/extra/Dijkstra/PureITreeDijkstra.v b/extra/Dijkstra/PureITreeDijkstra.v
index 4d107df0..6f75b74c 100644
--- a/extra/Dijkstra/PureITreeDijkstra.v
+++ b/extra/Dijkstra/PureITreeDijkstra.v
@@ -1,8 +1,8 @@
+From Coinduction Require Import all. 
+
 From ExtLib Require Import
      Structures.Monad.
 
-From Paco Require Import paco.
-
 From ITree Require Import
      Indexed.Sum
      ITree
@@ -22,7 +22,7 @@ Section PureITree.
   Definition PureITree A := itree void1 A.
 
   (*Morally, this is the type of pure itree specifcations. A sigma of this with a monotonicity requiremnet is used
-    in order to proved the ordered monad law*)
+    in order to prove the ordered monad law*)
   Definition _PureITreeSpec A := forall (p : itree void1 A -> Prop), resp_eutt p -> Prop.
 
 
@@ -153,8 +153,8 @@ Section PureITree.
   Proof.
     intros. intros t1 t2 Ht. split; intros.
     - destruct  H1.
-      + left. eapply H; eauto. symmetry. auto.
-      + right. eapply H0; eauto. symmetry. auto.
+      + left. eapply H; eauto. now rewrite <- Ht. 
+      + right. eapply H0; eauto. now rewrite <- Ht. 
     - destruct H1.
       + left. eapply H; eauto.
       + right. eapply H0; eauto.
@@ -226,43 +226,35 @@ Hint Constructors iterF_body : itree.
                                          iter_ind body p Hp a') ) .
 *)
 Hint Constructors iterF : itree.
-Lemma iterF_monotone {A B} (body:  (A -> PureITreeSpec (A + B)))
-      (sim sim' : A -> Prop) (a : A)
-      (p : itree void1 B -> Prop) (Hp : resp_eutt p)
-      (IN : iterF body a p Hp sim) (LE : sim <1= sim'):
-  iterF body a p Hp sim'.
-  Proof.
-    induction IN; constructor; auto.
-    destruct (body a) as [fa Hfa] eqn : Heq. simpl in *.
-    refine (Hfa _ _ _ _ _ H). intros. inversion H0; eauto with itree.
-  Qed.
 
   Definition iter_ {A B} sim (body : A -> PureITreeSpec (A + B)) a p Hp : Prop :=
     iterF body a p Hp sim.
   Hint Unfold iter_ : itree.
 
-  Lemma iterF_monotone' {A B} body p Hp : monotone1 (fun sim a => @iter_ A B sim body a p Hp).
-  Proof.
-    do 2 red. intros. eapply iterF_monotone; eauto.
-  Qed.
+  Lemma iter_mono {A B} body p Hp :
+  Proper (leq ==> leq) (fun sim a => @iter_ A B sim body a p Hp).
+  Proof. 
+    repeat red. intros. 
+    induction H0; constructor. 
+    destruct (body a) as [fa Hfa] eqn : Heq. simpl in *.
+    refine (Hfa _ _ _ _ _ H0). intros. inversion H1; eauto with itree.
+    eapply cont_a; eauto. now apply H. 
+Qed.
 
-  Hint Resolve iterF_monotone' : paco.
+  Definition iter_mon {A B} body p Hp := Build_mon (@iter_mono A B body p Hp).  
 
   Definition _iter {A B} :=
     fun (f : A -> PureITreeSpec (A + B) ) (a : A) (p : itree void1 B -> Prop) (Hp : resp_eutt p) =>
-      paco1 (fun (F : A -> Prop) a => @iter_ A B F f a p Hp ) bot1 a.
-
-
+      (gfp (@iter_mon A B f p Hp)) a.
 
-  Lemma iter_monot : forall A B (f : A -> PureITreeSpec (A + B) ) (a : A),
+      Lemma iter_monot : forall A B (f : A -> PureITreeSpec (A + B) ) (a : A),
                               monotonici B (_iter f a).
     Proof.
       unfold monotonici. intros. generalize dependent a.
-      pcofix CIH. pfold. intros. punfold H1.
-      red. red in H1. inversion H1; simpl in *.
+      coinduction c CIH; intros. step in H0.
+      inv H0. 
       constructor. destruct (f a) as [fa Hfa] eqn : Heq. simpl in *.
-      refine (Hfa _ _ _ _ _ H0). intros t. intros. inversion H2; subst; eauto with itree.
-      pclearbot. eapply cont_a; eauto with itree.
+      refine (Hfa _ _ _ _ _ H1). intros t. intros. inv H0; eauto with itree. 
     Qed.
 
   Definition iterp {A B} (body : A -> PureITreeSpec (A + B) ) (init : A) : PureITreeSpec B :=
@@ -304,7 +296,7 @@ Lemma iterF_monotone {A B} (body:  (A -> PureITreeSpec (A + B)))
       refine (Hw _ _ _ _ _ H).
       intros. destruct H0.
       + destruct H0 as [a [ Hvala Hpa]  ].
-        eapply Hp; eauto. symmetry. auto.
+        eapply Hp; eauto. now rewrite <- Hvala. 
       + destruct H0. apply div_spin_eutt in H0. eapply Hp; eauto.
     - simpl. intros. unfold _bindpi.
       refine (Hw _ _ _ _ _ H). intros. unfold _retpi.
@@ -374,13 +366,13 @@ Lemma iterF_monotone {A B} (body:  (A -> PureITreeSpec (A + B)))
     intros A B f a.
     constructor.
     (*this case went through without even needing coinduction???*)
-    - intros. red. repeat red in H. punfold H. destruct H.
+    - intros. red. repeat red in H. step in H. destruct H.
       cbn. unfold bindpi, _bindpi. destruct (f a) as [fa Hfa]; simpl in *.
       eapply Hfa; eauto. intros t ?Ht. inversion Ht; eauto.
       + left. exists (inr b). split; auto.
-      + left. exists (inl a'). split; auto. pclearbot. auto.
+      + left. exists (inl a'). split; auto.  auto.
     (*very suspicious that I no longer need to coinduct, I think I will move this onto a refactor branch to experiment on*)
-    - revert a. (* pcofix CIH. *) intros. cbn in H. pfold. unfold bindpi, _bindpi in H.
+    - revert a. (* coinduction c CIH. *) intros. cbn in H. step. unfold bindpi, _bindpi in H.
       constructor. destruct (f a) as [fa Hfa]; simpl in *. eapply Hfa; try apply H.
       intros t ?Ht. simpl in Ht. basic_solve; auto.
       + eapply cont_a; try apply H0. cbn in H1.
@@ -391,8 +383,8 @@ Lemma iterF_monotone {A B} (body:  (A -> PureITreeSpec (A + B)))
   Instance PureITreeIterNatural : IterNatural (Kleisli PureITreeSpec) sum.
   Proof.
     intros A B C. intros. constructor.
-    - intros. generalize dependent a. pcofix CIH. intros. pfold. repeat red in H.
-      punfold H0. destruct H0.
+    - intros. generalize dependent a. coinduction c CIH. intros. step. repeat red in H.
+      step in H0. destruct H0.
       destruct (f a) as [fa Hfa] eqn : Heq. simpl in *. constructor.
       cbn. rewrite Heq. simpl. unfold _bindpi. eapply Hfa; eauto.
       intros t ?Ht. basic_solve.
@@ -404,10 +396,10 @@ Lemma iterF_monotone {A B} (body:  (A -> PureITreeSpec (A + B)))
         * right. split; auto. eapply inf_tau; try apply spin_div. eapply Hp; eauto. symmetry. apply div_spin_eutt. auto.
       + left. exists (inl a'). split; auto. cbn. unfold _bindpi, _retpi, id. left. exists a'.
         split; try reflexivity. eapply cont_a; try reflexivity. right. apply CIH; auto.
-    - intros. generalize dependent a. pcofix CIH. intros. pfold. red.
+    - intros. generalize dependent a. coinduction c CIH. intros. step. red.
       repeat red in H0.
       constructor.
-      destruct (f a) as [fa Hfa] eqn : Heq. simpl in *. punfold H0. destruct H0. simpl in H.
+      destruct (f a) as [fa Hfa] eqn : Heq. simpl in *. step in H0. destruct H0. simpl in H.
       cbn in H. unfold bindpi, _bindpi in H. rewrite Heq in H. simpl in *. eapply Hfa; try apply H.
       intros t ?. simpl in *. basic_solve.
       + cbn in H1. unfold _bindpi, _retpi in H1. basic_solve. unfold id in *. basic_solve.
@@ -426,18 +418,18 @@ Lemma iterF_monotone {A B} (body:  (A -> PureITreeSpec (A + B)))
     intros A B C. intros. constructor.
     (* can't coinduct in this case it seems, fingers crossed I don't need to *)
     - intros. cbn. unfold bindpi, _bindpi. destruct (f a) as [fa Hfa] eqn : Heq. simpl.
-      cbn in H. punfold H. destruct H. cbn in H. unfold bindpi, _bindpi in H. rewrite Heq in H. simpl in *.
+      cbn in H. step in H. destruct H. cbn in H. unfold bindpi, _bindpi in H. rewrite Heq in H. simpl in *.
       eapply Hfa; try apply H. intros t ?. simpl in H0.
       basic_solve; auto.
       + rename a0 into b. left. exists (inl b). split; auto. cbn. cbn in H1. clear H. clear H0.
-        generalize dependent b. pcofix CIH.
-        intros. pfold. constructor. cbn. unfold bindpi, _bindpi.
+        generalize dependent b. coinduction c CIH.
+        intros. step. constructor. cbn. unfold bindpi, _bindpi.
         destruct (g b) as [gb Hgb] eqn : ?Heq. simpl in *. eapply Hgb; try apply H1.
         intros ?t ?Ht. basic_solve.
         * right. split; auto. apply inf_tau; auto. apply spin_div.
         * rename b0 into c. left. exists (inr c). split; auto. cbn. unfold _retpi.
           eapply term_b; eauto. reflexivity.
-        * left. exists (inl a'). split; auto. cbn. punfold Hcorec. destruct Hcorec. cbn in H.
+        * left. exists (inl a'). split; auto. cbn. step in Hcorec. destruct Hcorec. cbn in H.
           unfold bindpi, _bindpi in H. destruct (f a') as [fa' Hfa'] eqn :?Heq. simpl in *.
           eapply Hfa'; try apply H. intros ?t ?Ht. simpl in *. basic_solve.
           -- cbn in H2. rename a0 into b'. eapply cont_a; eauto. auto.
@@ -446,12 +438,12 @@ Lemma iterF_monotone {A B} (body:  (A -> PureITreeSpec (A + B)))
           -- apply inf_tau; auto.
       + cbn in H1. unfold _retpi in H1. basic_solve. rename b into c. left.
         exists (inr c). auto.
-  - intros. generalize dependent a. pcofix CIH.
-    intros. pfold. constructor. cbn. cbn in H0. unfold bindpi, _bindpi in *.
+  - intros. generalize dependent a. coinduction c CIH.
+    intros. step. constructor. cbn. cbn in H0. unfold bindpi, _bindpi in *.
     destruct (f a) as [fa Hfa] eqn : Heq. simpl in *. eapply Hfa; try apply H0.
     intros t ?. simpl in *. basic_solve.
     + rename a0 into b. left. exists (inl b). split; auto. cbn. cbn in H1. red in H1.
-      punfold H1. destruct H1. cbn in H1. unfold bindpi, _bindpi in H1. destruct (g b) as [gb Hgb] eqn : ?Heq.
+      step in H1. destruct H1. cbn in H1. unfold bindpi, _bindpi in H1. destruct (g b) as [gb Hgb] eqn : ?Heq.
       simpl in *. eapply Hgb; try apply H1. intros ?t ?Ht. simpl in *. clear H1.
       basic_solve.
       * cbn in H2. eapply cont_a; try apply H1. right. apply CIH. cbn.
@@ -470,8 +462,8 @@ Lemma iterF_monotone {A B} (body:  (A -> PureITreeSpec (A + B)))
   Instance PureITreeIterCodiagonal : IterCodiagonal (Kleisli PureITreeSpec) sum.
   Proof.
     intros A B f. constructor.
-    - intros. generalize dependent a. pcofix CIH. intros. cbn in H0. punfold H0.
-      pfold. destruct H0. constructor. cbn in H. cbn. punfold H.  destruct H.
+    - intros. generalize dependent a. coinduction c CIH. intros. cbn in H0. step in H0.
+      step. destruct H0. constructor. cbn in H. cbn. step in H.  destruct H.
       unfold bindpi, _bindpi. destruct (f a) as [fa Hfa] eqn : Heq. simpl in *. eapply Hfa; try apply H.
       intros t ?. simpl in *. basic_solve.
       + right. split; auto.
@@ -480,30 +472,30 @@ Lemma iterF_monotone {A B} (body:  (A -> PureITreeSpec (A + B)))
       + left. exists (inr (inl a0) ). clear H. split; auto. cbn. unfold _retpi.
         eapply cont_a; unfold id; try reflexivity. right. apply CIH. apply Hcorec.
       + left. exists (inl a'). split; auto. cbn. unfold _retpi.
-        eapply cont_a; try reflexivity. clear H. right. apply CIH. red. pfold.
-        red. constructor. punfold Hcorec. red in Hcorec. destruct Hcorec. destruct (f a') as [fa' Hfa'] eqn : ?Heq.
-        simpl in *. red. pfold. constructor. rewrite Heq0. simpl in *.
+        eapply cont_a; try reflexivity. clear H. right. apply CIH. red. step.
+        red. constructor. step in Hcorec. red in Hcorec. destruct Hcorec. destruct (f a') as [fa' Hfa'] eqn : ?Heq.
+        simpl in *. red. step. constructor. rewrite Heq0. simpl in *.
         eapply Hfa'; try apply H. clear H. intros ?t ?Ht. auto.
-    - intros. punfold H. generalize dependent a. pcofix CIH. intros. cbn in H0. pfold. constructor.
-      destruct H0. cbn in H. cbn.  unfold bindpi, _bindpi in H. pfold. constructor.
+    - intros. step in H. generalize dependent a. coinduction c CIH. intros. cbn in H0. step. constructor.
+      destruct H0. cbn in H. cbn.  unfold bindpi, _bindpi in H. step. constructor.
       destruct (f a) as [fa Hfa] eqn : Heq. simpl in *. eapply Hfa; try apply H.
       rename H into Ha.
       intros t ?. simpl in *. basic_solve.
       + cbn in H0. unfold _retpi in H0. basic_solve. eapply cont_a; try apply H.
         clear H.  left.
         generalize dependent a0.
-        pcofix CIH'. intros. pfold. constructor. clear Ha. punfold Hcorec.
+        coinduction c CIH'. intros. step. constructor. clear Ha. step in Hcorec.
         destruct Hcorec. cbn in H. unfold bindpi, _bindpi in H. simpl in *.
         destruct (f a0) as [fa0 Hfa0] eqn : ?Heq. simpl in *. eapply Hfa0; try apply H.
         clear H. intros ?t ?Ht. simpl in *. basic_solve.
         * cbn in H0. unfold _retpi in H0. basic_solve. eapply cont_a; try apply H. auto.
         * cbn in H0. unfold _retpi in H0. basic_solve. eapply term_b; try apply H. eapply cont_a; try reflexivity.
-          right. apply CIH. punfold Hcorec.
+          right. apply CIH. step in Hcorec.
         * cbn in H0. unfold _retpi, id in H0. basic_solve. eapply term_b; try apply H.
           eapply term_b; try reflexivity. auto.
         * apply inf_tau; auto.
       + cbn in H0. unfold _retpi, id in H0. basic_solve. eapply term_b; try apply H. eapply cont_a; try reflexivity.
-        right. apply CIH. punfold Hcorec.
+        right. apply CIH. step in Hcorec.
       + cbn in H0. unfold _retpi, id in H0. basic_solve. eapply term_b; try apply H. eapply term_b; try reflexivity.
         auto.
       + apply inf_tau; auto.
@@ -514,7 +506,7 @@ Lemma iterF_monotone {A B} (body:  (A -> PureITreeSpec (A + B)))
             (p : itree void1 B -> Prop) (Hp : resp_eutt void1 B p),
      proj1_sig (obsip B (iter f a)) p Hp -> proj1_sig (iterp (fun x => obsip _ (f x) ) a) p Hp.
   Proof.
-    intros. generalize dependent a. pcofix CIH. intros. pfold. constructor.
+    intros. generalize dependent a. coinduction c CIH. intros. step. constructor.
     cbn. red.
     simpl. specialize (unfold_iter_ktree f a) as Hunfold.
     cbn in H0. red in H0. symmetry in Hunfold. eapply Hp in H0;
@@ -539,7 +531,7 @@ Lemma iterF_monotone {A B} (body:  (A -> PureITreeSpec (A + B)))
       proj1_sig (iterp (fun x => obsip _ (f x) ) a) p Hp -> proj1_sig (obsip B (iter f a)) p Hp.
   Proof.
     intros. cbn. red. cbn in H. red in H. cbn in H.
-    punfold H. destruct H. cbn in H. red in H.
+    step in H. destruct H. cbn in H. red in H.
     basic_solve; auto.
     - apply div_spin_eutt in Ht as H1. eapply Hp; eauto.
       specialize (unfold_iter_ktree f a) as Hunfold. rewrite Hunfold. rewrite H1.
@@ -564,7 +556,7 @@ Lemma iterF_monotone {A B} (body:  (A -> PureITreeSpec (A + B)))
     exists 0. assert (resp_eutt _ _ (fun _  : itree void1 nat => False) ).
     { intros t1 t2. tauto. } exists H.
     split; auto.
-    pcofix CIH. pfold. constructor. cbn. red. eapply cont_a; eauto. reflexivity.
+    coinduction c CIH. step. constructor. cbn. red. eapply cont_a; eauto. reflexivity.
   Qed.
 
   Lemma iter_too_big : ~  forall A B (f : A -> itree void1 (A + B) ) (a : A)
@@ -583,7 +575,7 @@ Lemma iterF_monotone {A B} (body:  (A -> PureITreeSpec (A + B)))
     intros. constructor.
     -  apply obsip_pres_iter_right.
     - intros. cbn. red. cbn in H. unfold obsip, _obsip in H. simpl in H.
-      red in H. punfold H. destruct H. simpl in *.
+      red in H. step in H. destruct H. simpl in *.
       cbn in H.
   Abort.
 *)
@@ -617,11 +609,11 @@ Lemma iterF_monotone {A B} (body:  (A -> PureITreeSpec (A + B)))
     - specialize (eutt_reta_or_div t) as Hor. destruct Hor.
       + destruct H0 as [a Hreta ]. left. exists a. split; auto.
         eapply Hp; eauto. specialize (bind_ret_l a f) as H1. rewrite <- H1.
-        rewrite Hreta. reflexivity.
+        now rewrite Hreta. 
       + right. split; auto. apply div_spin_eutt in H0. rewrite (spin_bind f), <- H0; apply H.
     - destruct H.
       + destruct H as [a [Hreta Hpfa] ]. specialize (bind_ret_l a f) as H1.
-        eapply Hp; eauto.  rewrite <- H1. rewrite Hreta. reflexivity.
+        eapply Hp; eauto. now rewrite <- Hreta, H1. 
       + destruct H. apply div_spin_eutt in H.
         rewrite H, <- spin_bind. apply H0.
   Qed.
@@ -630,12 +622,12 @@ Lemma iterF_monotone {A B} (body:  (A -> PureITreeSpec (A + B)))
   Proof.
     split; intros; unfold obsip, _obsip in *; simpl in *.
     - intros p Hp. simpl. split; intros; eapply Hp; eauto.
-      symmetry. auto.
+      now rewrite <- H. 
     - set (fun t => t ≈ t1) as p.
       assert (Hp : resp_eutt p).
       + intros t3 t4. unfold p. split; intros.
-        * rewrite <- H1. symmetry. auto.
-        * rewrite H0. auto.
+        * rewrite <- H1. now symmetry. 
+        * now rewrite H0. 
       + specialize (H p Hp). simpl in *. unfold p in H. symmetry. apply H. reflexivity.
   Qed.
 
diff --git a/extra/Dijkstra/StateDelaySpec.v b/extra/Dijkstra/StateDelaySpec.v
index c95d184c..f81cbda4 100644
--- a/extra/Dijkstra/StateDelaySpec.v
+++ b/extra/Dijkstra/StateDelaySpec.v
@@ -2,8 +2,6 @@ From ExtLib Require Import
      Data.List
      Structures.Monad.
 
-From Paco Require Import paco.
-
 From ITree Require Import
      ITree
      ITreeFacts
diff --git a/extra/Dijkstra/StateIOTrace.v b/extra/Dijkstra/StateIOTrace.v
index 5d399fbe..565e6c57 100644
--- a/extra/Dijkstra/StateIOTrace.v
+++ b/extra/Dijkstra/StateIOTrace.v
@@ -1,4 +1,6 @@
-From Coq Require Import
+From Coinduction Require Import all. 
+
+From Stdlib Require Import
      Arith
      String.
 
@@ -8,8 +10,6 @@ From ExtLib Require Import
      Core.RelDec
      Data.Map.FMapAList.
 
-From Paco Require Import paco.
-
 From ITree Require Import
      Axioms
      ITree
@@ -78,12 +78,12 @@ Section PrintMults.
   Definition wnm_ev (next : nat) A  (io : IO A) (_ : A) : forall B, IO B -> B -> Prop :=
     match io with
     | Write n => write_next_mult (next + n)
-    | Read => bot3 end.
+    | Read => (fun _ _ _  => False) end.
 
   Variant writes_n (n : nat) : forall A, IO A -> A -> Prop :=
     | wn : writes_n n unit (Write n) tt.
 
-  Definition mults_n {R : Type} (n : nat) (tr : itrace IO R) := state_machine (wnm_ev n) bot4 (writes_n 0) bot1 tr.
+  Definition mults_n {R : Type} (n : nat) (tr : itrace IO R) := state_machine (wnm_ev n) (fun _ _ _ _ => False) (writes_n 0) (fun _ => False) tr.
 
   CoFixpoint mults_of_n_from_m {R : Type} (n m : nat) : itrace IO R:=
     Vis (evans unit (Write m) tt) (fun _ => mults_of_n_from_m n (n + m) ).
@@ -190,7 +190,7 @@ Section PrintMults.
     2 : destruct ev; assert void; try apply Hempty; try constructor; contradiction.
     assert (A = nat).
     {
-      destruct ev; auto. cbn in *. pinversion Href. ddestruction; subst.
+      destruct ev; auto. cbn in *. sinv Href. ddestruction; subst.
       cbn in *. inversion H1; auto.
     }
     subst. rename ans into n. exists n.
@@ -199,14 +199,14 @@ Section PrintMults.
     exists k0. split.
     {
       simpl in Href. clear Henv. unf_res.
-      pinversion Href. ddestruction; subst. inversion H1. ddestruction; subst. reflexivity.
+      sinv Href. ddestruction; subst. inversion H1. ddestruction; subst. reflexivity.
     }
     clear Hp p Hbhd b.
     assert (k0 tt ⊑ kp n).
-    { clear Heqkp. pinversion Href. ddestruction; subst.
+    { clear Heqkp. sinv Href. ddestruction; subst.
       unfold resum, ReSum_id, id_, Id_IFun in *. inversion H1. ddestruction; subst.
       assert (RAnsRef IO unit nat (evans nat Read n) tt Read n); auto with itree.
-      apply H6 in H. pclearbot. auto.
+      apply H6 in H.  auto.
     }
     clear Href ev. subst. rewrite bind_ret_l in H. simpl in *. rewrite interp_state_bind in H.
     rewrite interp_state_trigger in H. simpl in *. rewrite bind_ret_l in H.
@@ -231,15 +231,13 @@ Section PrintMults.
     generalize dependent tr.
     generalize dependent next_to_write.
 
-    pcofix CIH.
+    coinduction c CIH.
     (*This coinductive hypothesis looks good*)
     intros.
     rename H1 into HX.
-    pfold. red.
     (*should be able to learn that observe tr is what we need*)
 
     (*This block shows how to proceed through the loop body*)
-    rename H0 into H.
     unfold Basics.iter, MonadIter_stateT0, Basics.iter, MonadIter_itree in H.
     rewrite unfold_iter in H.
     match type of H with _ ⊑ ITree.bind _ ?k0 => remember k0 as k end.
@@ -254,18 +252,18 @@ Section PrintMults.
     rewrite bind_vis in H.
     setoid_rewrite bind_ret_l in H.
     unf_res.
-    punfold H. red in H. cbn in *.
+    step in H. cbn in *.
     dependent induction H.
-    2:{ rewrite <- x. constructor; auto. eapply IHruttF; eauto; reflexivity. }
+    2: { simpobs. constructor; auto. eapply IHruttF; eauto; reflexivity. }
     inversion H; ddestruction; subst; ddestruction; try contradiction.
     subst. specialize (H0 tt tt).
     destruct a.
-    prove_arg H0; auto with itree. pclearbot.
+    prove_arg H0; auto with itree. 
     match type of H0 with
-      paco2 _ bot2 ?tr ?t => assert (Hk1 : tr ⊑ t); auto end.
-    rewrite <- x. constructor; auto.
+      gfp _ _ ?tr ?t => assert (Hk1 : tr ⊑ t) by auto end.
+    simpobs. constructor; auto.
     intros [].
-    clear x tr. right.
+    clear x tr. 
     remember (lookup_default X 0 si) as n.
     remember (lookup_default Y 0 si) as m.
     eapply CIH with (Maps.add Y (n + m) si); try apply lookup_eq.
diff --git a/extra/Dijkstra/StateSpecT.v b/extra/Dijkstra/StateSpecT.v
index 1777cf7e..3c3e4bad 100644
--- a/extra/Dijkstra/StateSpecT.v
+++ b/extra/Dijkstra/StateSpecT.v
@@ -1,14 +1,13 @@
-From Coq Require Import
+From Stdlib Require Import
      Morphisms.
 
 From ExtLib Require Import
      Structures.Monad.
 
-From Paco Require Import paco.
-
 From ITree Require Import
      ITree
      ITreeFacts
+     HeterogeneousRelations
      Props.Infinite.
 
 From ITree.Extra Require Import
@@ -137,25 +136,26 @@ Section LoopInvarSpecific.
                (Hp : resp_eutt p) (Hq : resp_eutt q) ,
         (q (reassoc (g a s) )) ->
         (q -+> p) -> (forall t, q t -> q (t >>= (iter_lift ( iso_destatify_arrow g)  ))) ->
-         (p \1/ any_infinite) (MonadIter_stateT0 _ _ g a s) .
+         (Disj_unary _ p any_infinite) (MonadIter_stateT0 _ _ g a s) .
   Proof.
     intros.
     set (iso_destatify_arrow g) as g'.
-    enough ((p \1/ any_infinite) (ITree.iter g' (s,a) )).
+    enough ((Disj_unary _ p any_infinite) (ITree.iter g' (s,a) )).
     - assert (ITree.iter g' (s,a) ≈ iter g a s).
       + unfold g', iso_destatify_arrow.
         unfold iter, Iter_Kleisli, Basics.iter, MonadIterDelay, StateIter,
         MonadIter_stateT0, reassoc. unfold Basics.iter.
         unfold MonadIterDelay. eapply eutt_iter. intro.
         destruct a0 as [a' s']. simpl.
-        eapply eutt_clo_bind; try reflexivity. intros.
+        eapply eutt_bind_eutt; try reflexivity. intros.
         subst. destruct u2. simpl. destruct s1; reflexivity.
-      + assert (Hpdiv : resp_eutt (p \1/ any_infinite)).
-        { intros t1 t2 Heutt. split; intros; basic_solve.
-          - left. eapply Hp; eauto. symmetry. auto.
-          - right. rewrite <- Heutt. auto.
-          - left. eapply Hp; eauto.
-          - right. rewrite Heutt. auto.
+      + assert (Hpdiv : resp_eutt (Disj_unary _ p any_infinite)).
+        { intros t1 t2 Heutt. split; intros; 
+        destruct H4. 
+          - left. now rewrite <- Heutt.
+          - right. now rewrite <- Heutt. 
+          - left. now rewrite Heutt. 
+          - right. now rewrite Heutt. 
          }
         eapply Hpdiv; try apply H2. symmetry. auto.
      - eapply loop_invar; eauto.
@@ -170,11 +170,12 @@ Section LoopInvarSpecific.
     intros. unfold MonadIter_stateT0.
     apply iter_inl_spin. (*seems to require some coinduciton*)
     generalize dependent a. generalize dependent s.
-    pcofix CIH. intros. pinversion H0; try apply not_wf_F_mono'. pfold.
+    coinduction c CIH.  
+    intros. red in H; sinv H; try apply not_wf_F_mono'. 
     apply not_wf with (a' := a'); eauto.
     - red in Hrel. destruct a' as [s' a']. simpl. red. simpl. rewrite Hrel.
       rewrite bind_ret_l. simpl. reflexivity.
-    - right. destruct a'. eauto.
+    - destruct a'. eapply CIH; eauto.
   Qed.
 
   Lemma iter_wf_converge_state : forall (A B S : Type)  (g : A -> stateT S Delay (A + B) ) (a : A) (s : S),
diff --git a/extra/Dijkstra/TracesIT.v b/extra/Dijkstra/TracesIT.v
index 8d7b35d3..7d117dd4 100644
--- a/extra/Dijkstra/TracesIT.v
+++ b/extra/Dijkstra/TracesIT.v
@@ -1,11 +1,11 @@
-From Coq Require Import
+From Coinduction Require Import all. 
+
+From Stdlib Require Import
      Morphisms.
 
 From ExtLib Require Import
      Structures.Monad.
 
-From Paco Require Import paco.
-
 From ITree Require Import
      Axioms
      ITree
@@ -124,7 +124,7 @@ Section TraceSpec.
     - exfalso. assert (may_converge a (↑ log ++ Ret a) ).
       { apply may_converge_append. apply finite_list_to_stream. }
       eapply all_infinite_not_converge; eauto.
-    - left. exists a. exists log. split; auto. reflexivity.
+    - left. exists a. exists log. split; auto.
   Qed.
   Next Obligation.
     rename x into w. red. red. cbn. split; intros; basic_solve.
@@ -156,7 +156,7 @@ Section TraceSpec.
         apply all_infinite_bind. auto.
       + right. split; auto.
         destruct p as [p Hp]. simpl in *. eapply Hp; try apply H1.
-        eapply eutt_clo_bind with (UU := fun a b => False); intuition.
+        eapply eutt_bind_eutt with (UU := fun a b => False); intuition.
         apply noret_bind_nop. auto.
     - eapply apply_monot; try apply H. clear H. simpl. intros.
       basic_solve.
@@ -164,7 +164,7 @@ Section TraceSpec.
       + right. split; auto. right. split.
         * apply all_infinite_bind. auto.
         * destruct p as [p Hp]. simpl in *. eapply Hp; try apply H0.
-          eapply eutt_clo_bind with (UU := fun a b => False); intuition.
+          eapply eutt_bind_eutt with (UU := fun a b => False); intuition.
           apply euttNoRet_sym. apply noret_bind_nop. auto.
    Qed.
   Next Obligation.
@@ -196,7 +196,7 @@ Section TraceSpec.
     enough (↑ log ++ ITree.bind b' g' ≈ ITree.bind (↑ log ++ b') (fun _ => ITree.spin)).
     { rewrite H. auto. }
     unfold append. rewrite bind_bind.
-    eapply eutt_clo_bind with (RR := eq) (UU := eq); try reflexivity.
+    eapply eutt_bind_eutt with (RR := eq) (UU := eq); try reflexivity.
     intros. apply euttNoRet_subrel. eapply euttNoRet_trans with (t2 := b').
     + apply euttNoRet_sym. apply noret_bind_nop. eapply all_infinite_bind_append; eauto.
     + apply noret_bind_nop. eapply all_infinite_bind_append; eauto.
@@ -332,28 +332,26 @@ Proof.
   red in Hlog. apply H. clear H. subst. cbn. red. split; intros.
   - unfold append in *. rewrite bind_ret_l in H. rewrite bind_ret_l.
     unfold decide_ex in *.
-    generalize dependent b. pcofix CIH. intros b Hb Hdiv.
-    pfold. red.
+    generalize dependent b. coinduction c CIH. intros b Hb Hdiv.
     rewrite unfold_iter in Hb at 1. rewrite bind_bind in Hb.
     apply bind_trigger_refine in Hb as Hb'; try (exists true; auto).
     basic_solve. destruct a.
     + rewrite bind_ret_l in H0. cbn in H0. rewrite tau_eutt in H0.
-      punfold H. red in H. cbn in H. clear Hb.
-      enough (paco1 (trace_forall_ (is_bool true) (fun _ => True) ) r b).
-      { punfold H1. }
-      dependent induction H.
-      *  pfold. red. rewrite <- x. constructor; auto with itree. intros.
-        destruct a. right. pclearbot. eapply CIH.
+      step in H. clear Hb.
+      icbn.  
+      dependent induction H; simpobs. 
+      * constructor; auto with itree. intros.
+        destruct a. eapply CIH.
         ++ assert (k1 tt ≈ k' tt)%itree; try apply REL.
-           rewrite H. auto.
-        ++ apply simpobs in x. rewrite x in Hdiv. pinversion Hdiv.
+           now rewrite H. 
+        ++ apply simpobs in x. rewrite x in Hdiv. sinv Hdiv.
            ddestruction. apply H1.
-      *  pfold. red. rewrite <- x. constructor. left.  eapply IHeqitF; eauto.
+      * constructor. Utils.step. eapply IHeqitF; eauto.
          apply simpobs in x. rewrite x in Hdiv. rewrite tau_eutt in Hdiv. auto.
    + rewrite bind_ret_l in H0. cbn in H0. apply trace_refine_ret_inv_l in H0.
-     rewrite H in Hdiv. pinversion Hdiv. ddestruction.
+     rewrite H in Hdiv. sinv Hdiv. ddestruction.
      specialize (H2 tt).
-     rewrite H0 in H2. pinversion H2.
+     rewrite H0 in H2. sinv H2.
   - red. rewrite append_nil. rewrite append_nil in H. unfold decide_ex in *.
     induction H.
     + exfalso. rewrite H in H0. rewrite unfold_iter in H0.
@@ -365,17 +363,17 @@ Proof.
         clear IHmay_converge. rewrite unfold_iter in H0. rewrite bind_bind in H0.
         rewrite H in H0. eapply bind_trigger_refine in H0; try (exists true; auto).
         basic_solve.
-        pinversion H0. ddestruction.
+        sinv H0. ddestruction.
         assert (k tt ≈ k' tt)%itree; try apply REL. rewrite bind_ret_l in H2.
-        cbn in *. rewrite tau_eutt in H2. rewrite H3. auto.
+        cbn in *. rewrite tau_eutt in H2. now rewrite H0. 
       * clear IHmay_converge. rewrite unfold_iter in H0. rewrite bind_bind in H0.
         rewrite H in H0. eapply bind_trigger_refine in H0; try (exists true; auto).
         basic_solve.
-        pinversion H0. ddestruction.
+        sinv H0. ddestruction.
         rewrite bind_ret_l in H2. cbn in H2.
         apply trace_refine_ret_inv_l in H2.
         eapply front_and_last_base with (r := tt); eauto with itree.
-        pfold. red. cbn. constructor. intros. left.
+        step. cbn. constructor. intros.
         rewrite <- H2. destruct v. auto.
   Qed.
 
diff --git a/extra/IForest.v b/extra/IForest.v
index 48af2262..1fa864fa 100644
--- a/extra/IForest.v
+++ b/extra/IForest.v
@@ -12,6 +12,8 @@
    TODO: There may be a better definition of [bind]. *)
 
 (* begin hide *)
+From Coinduction Require Import all.
+
 From ITree Require Import
      Axioms
      ITree
@@ -19,13 +21,12 @@ From ITree Require Import
      Props.Leaf
      Basics.HeterogeneousRelations.
 
-From Paco Require Import paco.
-
 From ExtLib Require Import
      Structures.Functor.
 
-From Coq Require Import
+From Stdlib Require Import
      Relations
+     Program
      Morphisms.
 
 Import ITree.Basics.Basics.Monads.
@@ -141,28 +142,168 @@ Inductive interp_iforestF {E F} (h_spec : forall T, E T -> itree F T -> Prop)
 
 Lemma interp_iforestF_mono E F h_spec R RR  (t0 : itree' E R) (t1 : itree F R) sim sim'
       (IN : interp_iforestF h_spec RR sim t0 t1)
-      (LE : sim <2= sim') :
+      (LE : forall x y, sim x y -> sim' x y) :
   (interp_iforestF h_spec RR sim' t0 t1).
 Proof.
   induction IN; eauto with itree.
 Qed.
 
-#[global] Hint Resolve interp_iforestF_mono : paco.
+Definition interp_iforest_ E F h_spec R RR sim :
+  itree E R -> itree F R -> Prop :=
+  fun t0 t1 => interp_iforestF h_spec RR sim (observe t0) t1.
 
-Definition interp_iforest_ E F h_spec R RR sim (t0 : itree E R) (t1 : itree F R) : Prop :=
-  interp_iforestF h_spec RR sim (observe t0) t1.
-#[global] Hint Unfold interp_iforest_ : itree.
+#[global] Hint Unfold interp_iforest_ : itree. 
 
-Lemma interp_iforest__mono E F h_spec R RR : monotone2 (interp_iforest_ E F h_spec R RR).
+Definition interp_iforest_mon (E F : Type -> Type) (h_spec : E ~> iforest F) 
+           R (RR : relation R) : mon (itree E R -> itree F R -> Prop).
 Proof.
-  do 2 red. intros. eapply interp_iforestF_mono; eauto.
-Qed.
-#[global] Hint Resolve interp_iforest__mono : paco.
+  refine {| body := interp_iforest_ E F h_spec R RR |}.
+  intros sim sim' LE t0 t1 H. unfold interp_iforest_ in *.
+  eapply interp_iforestF_mono; eauto.
+Defined.
 
 (* Definition 5.2 *)
 Definition interp_iforest {E F} (h_spec : E ~> iforest F) :
   forall R (RR: relation R), itree E R -> iforest F R :=
-    fun R (RR: relation R) =>  paco2 (interp_iforest_ E F h_spec R RR) bot2.
+    fun R (RR: relation R) => gfp (interp_iforest_mon E F h_spec R RR).
+
+
+#[local] Ltac iunfold     := unfold euttge, eq_itree, eutt, eqit, interp_iforest.
+#[local] Ltac iunfold_in h := unfold euttge, eq_itree, eutt, eqit, interp_iforest in h.
+#[local] Ltac iunfold_all := unfold euttge, eq_itree, eutt, eqit, interp_iforest in *.
+
+#[local] Ltac refold :=
+  repeat match goal with
+  | |- context[gfp (@eqit_mon ?E ?b1 ?b2) ?R1 ?R2 ?RR] =>
+      fold (@eqit E R1 R2 RR b1 b2);
+      try fold (@eq_itree E _ _);
+      try fold (@euttge E _ _);
+      try fold (@eutt E _ _)
+  | |- context[gfp (interp_iforest_mon ?E ?F ?h ?R ?RR)] =>
+      fold (@interp_iforest E F h R RR)
+  end.
+
+#[local] Ltac refold_in h :=
+  match type of h with
+  | context[gfp (@eqit_mon ?E ?b1 ?b2) ?R1 ?R2 ?RR] =>
+      fold (@eqit E R1 R2 RR b1 b2) in h;
+      try fold (@eq_itree E _ _) in h;
+      try fold (@euttge E _ _) in h;
+      try fold (@eutt E _ _) in h
+  | context[gfp (interp_iforest_mon ?E ?F ?h ?R ?RR)] =>
+      fold (@interp_iforest E F h R RR) in h
+  end.
+
+#[local] Ltac to_mon_core :=
+  match goal with
+  | |- context[
+        @interp_iforest_ ?E ?F ?h_spec ?R ?RR ?sim ?t0 ?t1
+      ] =>
+      change (interp_iforest_ E F h_spec R RR sim t0 t1)
+      with (interp_iforest_mon E F h_spec R RR sim t0 t1)
+
+  | |- context[
+        @interp_iforestF ?E ?F ?h_spec ?R ?RR ?sim
+          (observe ?t0) ?t1
+      ] =>
+      change (interp_iforestF h_spec RR sim (observe t0) t1)
+      with (interp_iforest_mon E F h_spec R RR sim t0 t1)
+
+  | |- context[
+        @interp_iforestF ?E ?F ?h_spec ?R ?RR ?sim
+          (?con1 ?a1) ?t1
+      ] =>
+      change (interp_iforestF h_spec RR sim (con1 a1) t1)
+      with (interp_iforest_mon E F h_spec R RR
+              sim (go (con1 a1)) t1)
+
+  | |- context[
+        @interp_iforestF ?E ?F ?h_spec ?R ?RR ?sim
+          (observe ?t0) (?con2 ?a2)
+      ] =>
+      change (interp_iforestF h_spec RR sim (observe t0) (con2 a2))
+      with (interp_iforest_mon E F h_spec R RR
+              sim t0 (go (con2 a2)))
+  end.
+
+#[local] Ltac to_mon :=
+  let dummy := fresh "dummy" in
+  assert (dummy : True) by constructor;
+  intros;
+  to_mon_core;
+  revert_until dummy;
+  clear dummy.
+
+#[local] Ltac to_mon_in h :=
+  match type of h with
+  | context[
+      @interp_iforestF ?E ?F ?h_spec ?R ?RR ?sim
+        (observe ?t0) ?t1
+    ] =>
+      change (interp_iforestF h_spec RR sim (observe t0) t1)
+      with (interp_iforest_mon E F h_spec R RR sim t0 t1) in h
+
+  | context[
+      @interp_iforestF ?E ?F ?h_spec ?R ?RR ?sim
+        (?con1 ?a1) ?t1
+    ] =>
+      change (interp_iforestF h_spec RR sim (con1 a1) t1)
+      with (interp_iforest_mon E F h_spec R RR
+              sim (go (con1 a1)) t1) in h
+  end.
+
+#[local] Ltac icbn :=
+  cbn[eqit_mon body eqit_ interp_iforest_mon interp_iforest_];
+  try unfold interp_iforest_. 
+
+#[local] Ltac icbn_in H :=
+  cbn[eqit_mon body eqit_ interp_iforest_mon interp_iforest_] in H;
+  try unfold interp_iforest_ in H.
+
+#[local] Tactic Notation "icbn" "in" ident(h) := icbn_in h.
+#[local] Tactic Notation "icbn" "in" "*" :=
+  cbn[eqit_mon body eqit_ interp_iforest_mon interp_iforest_] in *;
+  try unfold interp_iforest_ in *. 
+
+#[local] Tactic Notation "refold" "in" ident(h) := refold_in h.
+#[local] Tactic Notation "to_mon" "in" ident(h) := to_mon_in h.
+#[local] Tactic Notation "iunfold" "in" ident(h) := iunfold_in h.
+#[local] Tactic Notation "iunfold" "in" "*" := iunfold_all.
+
+
+#[local] Tactic Notation "step" :=
+  iunfold; step; icbn; try refold.
+
+#[local] Tactic Notation "unstep" :=
+  iunfold; try to_mon; unstep; try refold.
+
+#[local] Tactic Notation "step" "in" ident(h) :=
+  iunfold in h; step in h; icbn in h; try refold_in h.
+
+#[local] Tactic Notation "unstep" "in" ident(h) :=
+  iunfold_in h; try to_mon_in h; unstep_in h; try refold_in h.
+
+#[local] Tactic Notation "icoinduction" simple_intropattern(R) simple_intropattern(H) :=
+  iunfold_coind; coinduction R H; icbn.
+
+#[local] Tactic Notation "coinduction" simple_intropattern(R) simple_intropattern(H) :=
+  icoinduction R H;
+  to_mon.
+
+#[local] Tactic Notation "coinduction" :=
+  let c := fresh "c" in
+  let CIH := fresh "CIH" in
+  coinduction c CIH.
+
+#[local] Ltac bcbn :=
+  cbn[eqit_mon body eqit_ interp_iforest_mon interp_iforest_];
+  cbn; 
+  to_mon.
+  
+(* step -> inversion; common pattern for eutt Hyps *)
+Ltac sinv H := step in H; inv H. 
+
+
 
 (* Figure 7: Interpreter law for Ret *)
 Lemma interp_iforest_ret :
@@ -174,93 +315,87 @@ Proof.
   repeat red.
   split; [| split].
   - intros. split; intros.
-    + unfold interp_iforest in H0.
-      pinversion H0. subst.
-      cbn. rewrite <- H. assumption.
-    + pstep. econstructor. reflexivity. rewrite H. cbn in H0. assumption.
-  - do 3 red.
-    intros t1 t2 eq; split; intros H; pinversion H; subst.
-    + red. pstep. econstructor. reflexivity. rewrite <- eq. assumption.
-    + red. pstep. econstructor. reflexivity. rewrite eq. assumption.
- - do 3 red. intros. split; intros; cbn in *. rewrite <- H. assumption. rewrite H; assumption.
+    + step in H0. inv H0.
+      cbn. now rewrite <- H.
+    + unfold interp_iforest. step. econstructor; eauto. now rewrite H.
+  - repeat red.
+    intros t1 t2 eq; split; intros H; sinv H. 
+    + step. econstructor; eauto. now rewrite <- eq. 
+    + step. econstructor; eauto. now rewrite eq. 
+ - repeat red. intros. split; intros; cbn in *. now rewrite <- H. now rewrite H. 
 Qed.
 
 #[global] Instance interp_iforestF_Proper
        {E F} (h_spec : E ~> iforest F) R RR (t : itree' E R)
        (sim : itree E R -> itree F R -> Prop)
-       (HS: forall t, Proper(eutt eq ==> flip impl) (sim t))
+       (HS: forall t, Proper (eutt eq ==> flip impl) (sim t))
   :
   Proper(eutt eq ==> iff) (interp_iforestF h_spec RR sim t).
 Proof.
-  do 2 red.
+  repeat red.
   intros.
   split; intros.
   - inversion H0; subst; econstructor; eauto.
-    + rewrite <- H. assumption.
-    + specialize (HS t1). rewrite <- H. assumption.
-    + rewrite <- H. assumption.
+    + now rewrite <- H.
+    + specialize (HS t1). now rewrite <- H.
+    + now rewrite <- H.
 
-  - inversion H0; subst; econstructor; eauto.
-    rewrite H. assumption. specialize (HS t1). rewrite H. assumption.
-    rewrite H. assumption.
+  - inversion H0; subst; econstructor; eauto. 
+    all: now rewrite H. 
 Qed.
 
 #[global] Instance interp_iforest_Proper
-       {E F} (h_spec : E ~> iforest F) R RR (t : itree E R) :
-  Proper(eq_itree Logic.eq ==> iff) (interp_iforest h_spec R RR t).
+       {E F} (h_spec : E ~> iforest F) R RR (t : itree E R) 
+       (c : Chain (interp_iforest_mon E F h_spec R RR))
+       :
+  Proper (eq_itree eq ==> iff) (elem c t).
 Proof.
-  do 2 red.
-  intros.
-  split.
-  - revert t x y H.
-    pcofix CIH.
-    intros t x y eq HI.
-    red in HI. punfold HI. red in HI.
-    pstep. red. genobs t ot.
-    inversion HI; subst; econstructor; eauto.
-    + rewrite <- eq. assumption.
-    + pclearbot. right. eapply CIH; eauto.
-    + rewrite <- eq. apply eq2.
-    + intros. specialize (HK a H0). pclearbot. right. eapply CIH. 2 : { apply HK. } reflexivity.
-  - revert t x y H.
-    pcofix CIH.
-    intros t x y eq HI.
-    red in HI. punfold HI. red in HI.
-    pstep. red. genobs t ot.
-    inversion HI; subst; econstructor; eauto.
-    + rewrite eq. assumption.
-    + pclearbot. right. eapply CIH; eauto.
-    + rewrite eq. apply eq2.
-    + intros. specialize (HK a H0). pclearbot. right. eapply CIH. 2 : { apply HK. } reflexivity.
+  repeat red. revert t.
+  (* apply tower.
+  inf_closed_forall_auto.
+  intros T HT. split. repeat intro. apply HT. apply H0. 
+  apply H, H0.     *)
+  tower induction.    
+    split.
+  - intros HI.
+    repeat red; repeat red in HI.  
+    inv HI.  
+    + rewrite H0 in eq2. 
+      eapply Interp_iforest_Ret; eauto. 
+    + econstructor. symmetry in H0. eapply H; eauto.  
+    + econstructor; eauto. now rewrite <- H0. 
+  - intros HI.
+    repeat red; repeat red in HI.  
+    inv HI.  
+    + rewrite <- H0 in eq2. 
+      eapply Interp_iforest_Ret; eauto. 
+    + econstructor. eapply H; eauto.  
+    + econstructor; eauto. now rewrite H0. 
 Qed.
 
 #[global] Instance interp_iforest_Proper2
-       {E F} (h_spec : E ~> iforest F) R RR (t : itree E R) :
-  Proper(eutt Logic.eq ==> iff) (interp_iforest h_spec R RR t).
+              {E F} (h_spec : E ~> iforest F) R RR (t : itree E R) 
+       (c : Chain (interp_iforest_mon E F h_spec R RR))
+       :
+  Proper (eutt eq ==> iff) (elem c t).
 Proof.
-  do 2 red.
-  intros.
-  split.
-  - revert t x y H.
-    pcofix CIH.
-    intros t x y eq HI.
-    red in HI. punfold HI. red in HI.
-    pstep. red. genobs t ot.
-    inversion HI; subst; econstructor; eauto.
-    + rewrite <- eq. assumption.
-    + pclearbot. right. eapply CIH; eauto.
-    + rewrite <- eq. apply eq2.
-    + intros. specialize (HK a H0). pclearbot. right. eapply CIH. 2 : { apply HK. } reflexivity.
-  - revert t x y H.
-    pcofix CIH.
-    intros t x y eq HI.
-    red in HI. punfold HI. red in HI.
-    pstep. red. genobs t ot.
-    inversion HI; subst; econstructor; eauto.
-    + rewrite eq. assumption.
-    + pclearbot. right. eapply CIH; eauto.
-    + rewrite eq. apply eq2.
-    + intros. specialize (HK a H0). pclearbot. right. eapply CIH. 2 : { apply HK. } reflexivity.
+  repeat red. revert t. 
+  tower induction. 
+    split.
+  - intros HI.
+    repeat red; repeat red in HI.  
+    inv HI.  
+    + rewrite H0 in eq2. 
+      eapply Interp_iforest_Ret; eauto. 
+    + econstructor. symmetry in H0. eapply H; eauto.  
+    + econstructor; eauto. now rewrite <- H0. 
+  - intros HI. 
+    repeat red; repeat red in HI.  
+    inv HI.  
+    + rewrite <- H0 in eq2. 
+      eapply Interp_iforest_Ret; eauto. 
+    + econstructor. eapply H; eauto.  
+    + econstructor; eauto. now rewrite H0. 
 Qed.
 
 (* This exists in the stdlib as [ProofIrrelevance.inj_pair2], but we reprove
@@ -280,59 +415,33 @@ Proof.
 Qed.
 
 #[global] Instance interp_iforest_Proper3
-       {E F} (h_spec : E ~> iforest F) R RR :
-  Proper(eq_itree eq ==> eq  ==> iff) (interp_iforest h_spec R RR).
+       {E F} (h_spec : E ~> iforest F) R RR 
+       (c : Chain (interp_iforest_mon E F h_spec R RR))
+       :
+  Proper (eq_itree eq ==> eq ==> iff) (elem c).
 Proof.
-  do 4 red.
-  intros; split.
-  - subst.
-    revert x y H y0.
-    pcofix CIH.
-    intros x y eq t H.
-    pstep; red.
-    punfold H. red in H.
-
-    punfold eq. red in eq.
-    genobs x obsx.
-    genobs y obsy.
-    revert x y Heqobsx Heqobsy t H.
-
-    induction eq; intros x y Heqobsx Heqobsy t H; inversion H; subst; pclearbot.
-    + econstructor; eauto.
-    + econstructor. right. eapply CIH. apply REL. apply HS.
-    + apply inj_pair2 in H2.
-      apply inj_pair2 in H3. subst.
-      econstructor; eauto. intros X HX. specialize (REL X). specialize (HK X HX). pclearbot.
-      right. eapply CIH; eauto.
-    + eapply IHeq.  reflexivity. reflexivity.
-      punfold HS.
-    + econstructor. left. pstep. eapply IHeq. reflexivity. reflexivity. assumption.
-    + econstructor. left.  pstep. eapply IHeq. reflexivity. reflexivity. assumption.
-    + econstructor. left.  pstep. eapply IHeq. reflexivity. reflexivity. assumption.
-
- - subst.
-    revert x y H y0.
-    pcofix CIH.
-    intros x y eq t H.
-    pstep; red.
-    punfold H. red in H.
-
-    punfold eq. red in eq.
-    genobs x obsx.
-    genobs y obsy.
-    revert x y Heqobsx Heqobsy t H.
-
-    induction eq; intros x y Heqobsx Heqobsy t H; inversion H; subst; pclearbot.
-    + econstructor; eauto.
-    + econstructor. right. eapply CIH. apply REL. apply HS.
-    + apply inj_pair2 in H2.
-      apply inj_pair2 in H3. subst.
-      econstructor; eauto. intros X HX. specialize (REL X). specialize (HK X HX). pclearbot.
-      right. eapply CIH; eauto.
-    + econstructor. left. pstep. eapply IHeq. reflexivity. reflexivity. assumption.
-    + econstructor. left. pstep. eapply IHeq. reflexivity. reflexivity. assumption.
-    + econstructor. left. pstep. eapply IHeq. reflexivity. reflexivity. assumption.
-    + eapply IHeq. reflexivity. reflexivity.   punfold HS.
+  repeat red. tower induction. 
+    split.
+  - intros HI.
+    repeat red; repeat red in HI. 
+    step in H0.   
+    inv HI; simpobs.
+    + inv H0. eapply Interp_iforest_Ret; eauto. 
+    + inv H0. econstructor. symmetry in REL. eapply H; eauto. 
+    + eapply eqitF_inv_VisF_l in H0. crunch; try easy. 
+      simpobs. econstructor; eauto. intros. 
+      symmetry in H1. eapply H. 
+      apply H1. all: eauto.
+  - intros HI.
+    repeat red; repeat red in HI.
+    step in H0.   
+    inv HI; simpobs.   
+    + inv H0. eapply Interp_iforest_Ret; eauto. 
+    + inv H0. econstructor. eapply H; eauto. 
+    + eapply eqitF_inv_VisF_r in H0. crunch; try easy. 
+      simpobs. econstructor; eauto. intros. 
+      eapply H.  
+      apply H1. all: eauto.
 Qed.
 
 (* Lemma 5.4: interp_iforest_correct - note that the paper presents a slightly simpler formulation where t = t' *)
@@ -343,30 +452,22 @@ Lemma interp_iforest_correct_exec:
 Proof.
   intros.
   revert t t' H1.
-  pcofix CIH.
+  coinduction.
   intros t t' eq.
-  pstep.
-  red.
   unfold interp, Basics.iter, MonadIter_itree.
   rewrite (itree_eta t) in eq.
-  destruct (observe t).
-  - econstructor. reflexivity. rewrite <- eq. rewrite unfold_iter. cbn.
-    rewrite Eqit.bind_ret_l. cbn.  reflexivity.
-  - econstructor. right.
-    eapply CIH. rewrite tau_eutt in eq. rewrite eq. reflexivity.
-  - econstructor.
-    2 : { rewrite <- eq. rewrite unfold_iter. cbn.
-          unfold ITree.map. rewrite Eqit.bind_bind.
-          setoid_rewrite Eqit.bind_ret_l at 1. cbn. setoid_rewrite tau_eutt.
-          reflexivity. }
-    apply H.
-    intros a. cbn.
-    right.
-    unfold interp, Basics.iter, MonadIter_itree in CIH. unfold fmap, Functor_itree, ITree.map in CIH.
-    specialize (CIH (k a) (k a)).
-    apply CIH.
-    reflexivity.
-Qed.
+  destruct (observe t) eqn:oeqt. 
+  - rewrite <- eq. rewrite unfold_iter. bcbn. 
+    rewrite Eqit.bind_ret_l. repeat red. simpobs. now econstructor. 
+  - rewrite <- eq. rewrite unfold_iter. bcbn. rewrite Eqit.bind_ret_l.
+    rewrite tau_eutt. 
+    repeat red. simpobs. econstructor. now apply CIH.  
+  - rewrite <- eq. rewrite unfold_iter. bcbn.
+    rewrite bind_map. repeat red; simpobs. econstructor.
+    + apply H. 
+    + ebind. intros; subst. rewrite tau_eutt. reflexivity. 
+    + intros. rewrite tau_eutt. now apply CIH. 
+Qed. 
 
 (* Lemma 5.5 - note that the paper presents this lemma after unfolding the definition of Proper.
  *)
@@ -375,46 +476,36 @@ Qed.
     Proper (@eutt _ _ _ RR ==> eq ==> flip Basics.impl) (@interp_iforest E _ h_spec R RR).
 Proof.
   intros.
-
-  do 5 red.
+  repeat red.
   intros t1 t2 eqt s' s eqs HI.
   subst.
-
   revert t1 t2 eqt s HI.
-
-  pcofix CIH.
-
+  icoinduction c CIH. 
   intros.
+  step in HI.
 
-  pstep. red.
-  punfold HI. red in HI.
-
-  punfold eqt. red in eqt.
+  step in eqt. 
   genobs t1 obst1.
   genobs t2 obst2.
   revert t1 t2 Heqobst1 Heqobst2 s HI.
-
   induction eqt; intros.
-  - inversion HI; subst.
-    econstructor. etransitivity; eauto. assumption.
-  - inversion HI; subst.
-    econstructor. pclearbot. right.  eapply CIH; eauto.
-  - inversion HI.
-    subst.
+  - inv HI. econstructor. etransitivity; eauto. eauto.  
+  - inv HI. 
+    econstructor. eapply CIH; eauto.
+  - inv HI. 
     apply inj_pair2 in H1.
     apply inj_pair2 in H2.
     subst.
     econstructor.
     apply HTA.
     apply eq2.
-    intros a Ha. specialize (REL a). specialize (HK a Ha). red in REL. pclearbot.
-    right. eapply CIH. apply REL. apply HK.
-  - econstructor.
-    left. pstep. red. eapply IHeqt. reflexivity. eassumption. assumption.
-  - inversion HI; subst.
-    pclearbot.
+    intros a Ha. specialize (REL a). specialize (HK a Ha). red in REL. 
+    eapply CIH. apply REL. apply HK.
+  - econstructor. step. 
+    eapply IHeqt. reflexivity. eassumption. assumption.
+  - inv HI. 
     eapply IHeqt. reflexivity. reflexivity.
-    pinversion HS.
+    now unstep. 
 Qed.
 
 Lemma Leaf_Vis_sub :  forall {E} {R} X (e : E X) (k : X -> itree E R) u x, Leaf u (k x) -> Leaf u (Vis e k).
@@ -427,18 +518,13 @@ Lemma eutt_Leaf_ : forall {E} {R} (RR : R -> Prop) (ta : itree E R)
    (IN: forall (a : R), Leaf a ta -> RR a), eutt (fun u1 u2 => u1 = u2 /\ RR u1) ta ta.
 Proof.
   intros E R.
-  ginit.
-  gcofix CIH; intros.
-
+  icoinduction c CIH. intros. 
   setoid_rewrite (itree_eta ta) in IN.
-
-  gstep. red.
-
   destruct (observe ta).
-  - econstructor.  split; auto. apply IN. econstructor. reflexivity.
-  - econstructor. gfinal. left. apply CIH. intros. eapply IN. rewrite tau_eutt. assumption.
-  - econstructor. intros. red.
-    gfinal. left. apply CIH. intros. eapply IN. eapply Leaf_Vis_sub. apply H.
+  - econstructor.  split; auto. apply IN. now econstructor.
+  - econstructor. apply CIH. intros. eapply IN. now rewrite tau_eutt.
+  - econstructor. intros. 
+    apply CIH. intros. eapply IN. eapply Leaf_Vis_sub. apply H.
 Qed.
 
 Lemma eutt_Leaf : forall E R (ta : itree E R), eutt (fun u1 u2 => u1 = u2 /\ Leaf u1 ta) ta ta.
@@ -458,26 +544,26 @@ Proof.
   red.
   split; [| split].
   - intros; split; intros.
-    + unfold trigger in H0. red in H0.
-      pinversion H0; subst.
+    + unfold trigger in H0. step in H0. 
+      inv H0. 
       apply inj_pair2 in H3. apply inj_pair2 in H4.
       subst.
       unfold subevent, resum, ReSum_id, Id_IFun, id_ in HTA.
       rewrite eq2 in H.
       assert (x <- ta ;; k2 x ≈ ta).
       { rewrite <- (Eqit.bind_ret_r ta).
-        apply eutt_clo_bind with (UU := fun u1 u2 => u1 = u2 /\ Leaf u1 ta).
+        apply eutt_bind_eutt with (UU := fun u1 u2 => u1 = u2 /\ Leaf u1 ta).
         rewrite Eqit.bind_ret_r. apply eutt_Leaf.
-        intros. destruct H1. subst. specialize (HK u2 H2). pclearbot. pinversion HK. subst. assumption.
+        intros. destruct H0. subst. specialize (HK u2 H1). step in HK. inv HK.
       }
-      rewrite H1 in H.
-      specialize (HP R e e eq_refl).  unfold Eq1_iforest in HP. destruct HP as (P & _ & _).
+      rewrite H0 in H.
+      specialize (HP R e e eq_refl). unfold Eq1_iforest in HP. destruct HP as (P & _ & _).
       rewrite P. apply HTA. symmetry. assumption.
     + unfold trigger, subevent, resum, ReSum_id, Id_IFun, id_.
-      red. pstep. eapply Interp_iforest_Vis with (k2 := (fun x : R => Ret x)).
+      step. eapply Interp_iforest_Vis with (k2 := (fun x : R => Ret x)).
       * apply H0.
       * unfold bind, Monad_itree. rewrite Eqit.bind_ret_r. assumption.
-      * intros a. left. pstep. red. econstructor. reflexivity.  reflexivity.
+      * intros. step. econstructor; eauto.
   - hnf. intros; split; intros.
     rewrite <- H. assumption.
     rewrite H. assumption.
@@ -506,8 +592,7 @@ Lemma interp_iforest_spin_accepts_anything :
     interp_iforest h_spec R RR ITree.spin t.
 Proof.
   intros.
-  pcofix CIH.
-  pstep. red. cbn. econstructor. right. apply CIH.
+  icoinduction c CIH. cbn. econstructor. apply CIH. 
 Qed.
 
 (* Figure 7: Structural law for tau *)
@@ -520,10 +605,9 @@ Proof.
   split; [| split].
   - intros; split; intros.
     + rewrite <- H.
-      pstep. red. econstructor. left. apply H0.
+      step. now econstructor. 
     + rewrite H.
-      pinversion H0. subst.
-      apply HS.
+      step in H0. inv H0.
   - typeclasses eauto.
   - typeclasses eauto.
 Qed.
@@ -536,8 +620,7 @@ Lemma interp_iforest_ret_inv :
      exists  r2, RR r1 r2 /\ t ≈ ret r2.
 Proof.
   intros.
-  punfold H.
-  red in H. inversion H; subst.
+  step in H. inv H. 
   exists r2; eauto.
 Qed.
 
@@ -551,8 +634,7 @@ Lemma interp_iforest_vis_inv :
       h_spec S e ms /\ t ≈ (bind ms ks).
 Proof.
   intros.
-  punfold H.
-  red in H. inversion H; subst.
+  sinv H. 
   apply inj_pair2 in H2.
   apply inj_pair2 in H3.
   subst.
@@ -567,10 +649,7 @@ Lemma interp_iforest_tau_inv :
     interp_iforest h_spec R RR s t.
 Proof.
   intros.
-  punfold H.
-  red in H. inversion H; subst.
-  pclearbot.
-  apply HS.
+  sinv H. 
 Qed.
 
 Lemma case_iforest_handler_correct:
@@ -618,99 +697,32 @@ Definition iter_cont {I E R} (step' : I -> itree E (I + R)) :
               ITree.bind (step' i) (@iter_cont I E R step') ≈ r /\
               (forall j, step j (step' j))).
 
-Section LeafBind.
-
-  Context {E : Type -> Type} {R S : Type}.
-
-  Import ITreeNotations.
-  Local Open Scope itree.
-
-  Inductive eqit_Leaf_bind_clo b1 b2 (r : itree E R -> itree E S -> Prop) :
-    itree E R -> itree E S -> Prop :=
-  | pbc_intro_h U (t1 t2: itree E U) (k1 : U -> itree E R) (k2 : U -> itree E S)
-                (EQV: eqit eq b1 b2 t1 t2)
-                (REL: forall u, Leaf u t1 -> r (k1 u) (k2 u))
-    : eqit_Leaf_bind_clo b1 b2 r (ITree.bind t1 k1) (ITree.bind t2 k2)
-  .
-  Hint Constructors eqit_Leaf_bind_clo: itree.
-
-  Lemma eqit_Leaf_clo_bind  (RS : R -> S -> Prop) b1 b2 vclo
-        (MON: monotone2 vclo)
-        (CMP: compose (eqitC RS b1 b2) vclo <3= compose vclo (eqitC RS b1 b2))
-        (ID: id <3= vclo):
-    eqit_Leaf_bind_clo b1 b2 <3= gupaco2 (eqit_ RS b1 b2 vclo) (eqitC RS b1 b2).
-  Proof.
-    gcofix CIH. intros. destruct PR.
-    guclo eqit_clo_trans.
-    econstructor; auto_ctrans_eq; try (rewrite (itree_eta (x <- _;; _ x)), unfold_bind; reflexivity).
-    punfold EQV. unfold_eqit.
-    genobs t1 ot1.
-    genobs t2 ot2.
-    hinduction EQV before CIH; intros; pclearbot.
-    - guclo eqit_clo_trans.
-      econstructor; auto_ctrans_eq; try (rewrite <- !itree_eta; reflexivity).
-      gbase; cbn.
-      apply REL0.
-      rewrite itree_eta, <- Heqot1; constructor; reflexivity.
-    - gstep. econstructor.
-      gbase.
-      apply CIH.
-      constructor; auto.
-      intros u HR.
-      apply REL0.
-      rewrite itree_eta,  <- Heqot1.  econstructor 2. reflexivity. assumption.
-    - gstep. econstructor.
-      intros; apply ID; unfold id.
-      gbase.
-      apply CIH.
-      constructor; auto. eapply REL.
-      intros ? HR; apply REL0.
-      rewrite itree_eta, <- Heqot1.
-      econstructor 3; eauto; reflexivity.
-    - destruct b1; try discriminate.
-      guclo eqit_clo_trans.
-      econstructor.
-      3:{ eapply IHEQV; eauto.
-          intros ? HR; apply REL.
-          rewrite itree_eta, <- Heqot1; econstructor 2. reflexivity. eauto.
-      }
-      3,4:auto_ctrans_eq.
-      2: reflexivity.
-      eapply eqit_Tau_l. rewrite unfold_bind, <-itree_eta. reflexivity.
-    - destruct b2; try discriminate.
-      guclo eqit_clo_trans.
-      econstructor; auto_ctrans_eq; cycle -1; eauto; try reflexivity.
-      eapply eqit_Tau_l. rewrite unfold_bind, <-itree_eta. reflexivity.
-  Qed.
-
-End LeafBind.
-
 Lemma eqit_Leaf_bind' {E} {R} {T} b1 b2
     (t1 t2: itree E T) (k1 k2: T -> itree E R) :
     eqit eq b1 b2 t1 t2 ->
     (forall r, Leaf r t1 -> eqit eq b1 b2 (k1 r) (k2 r)) ->
-  @eqit E _ _ eq b1 b2 (ITree.bind t1 k1) (ITree.bind t2 k2).
+  eqit eq b1 b2 (ITree.bind t1 k1) (ITree.bind t2 k2).
 Proof.
-  intros. ginit. guclo (@eqit_Leaf_clo_bind E R R eq). unfold eqit in *.
-  econstructor; eauto with paco.
+  intros. eapply eqit_clo_bind_gen; eauto. intros; subst. 
+  eapply H0. eauto. 
 Qed.
 
 Lemma eqit_Leaf_bind'' {E} {R S} {T} (RS : R -> S -> Prop) b1 b2
     (t1 t2: itree E T) (k1: T -> itree E R) (k2 : T -> itree E S) :
     eqit eq b1 b2 t1 t2 ->
     (forall r, Leaf r t1 -> eqit RS b1 b2 (k1 r) (k2 r)) ->
-  @eqit E _ _ RS b1 b2 (ITree.bind t1 k1) (ITree.bind t2 k2).
+  eqit RS b1 b2 (ITree.bind t1 k1) (ITree.bind t2 k2).
 Proof.
-  intros. ginit. guclo (@eqit_Leaf_clo_bind E R S RS). unfold eqit in *.
-  econstructor; eauto with paco.
+  intros. eapply eqit_clo_bind_gen; eauto. intros; subst. 
+  eapply H0. eauto. 
 Qed.
 
 Lemma eutt_ret_vis_abs: forall {X Y E} (x: X) (e: E Y) k, Ret x ≈ Vis e k -> False.
 Proof.
   intros.
-  punfold H; inv H.
+  now sinv H. 
 Qed.
-
+(*  *)
 Ltac simpl_iter :=
     unfold iter, Iter_Kleisli, Basics.iter, MonadIter_itree.
 
@@ -792,7 +804,7 @@ Proof.
     subst.
     do 3 red. intros.
     destruct a0. rewrite Eqit.bind_bind.
-    eapply eutt_clo_bind. reflexivity.
+    eapply eutt_bind_eutt. reflexivity.
     intros. rewrite H. destruct u2;
     rewrite Eqit.bind_ret_l; cbn; reflexivity.
   }
@@ -948,12 +960,11 @@ Proof.
       destruct eqtt' as (ta & k & HPA & EQ & HRET).
       eapply H; [symmetry; eauto | clear eq t'].
       eapply H; [eauto | clear EQ t].
-      eapply H; eauto.
+      eapply H. 2: eauto.
       rewrite <- (Monad.bind_ret_r _ ta) at 2.
       apply eqit_Leaf_bind'; [reflexivity |].
         intros.
         rewrite (HRET r); auto.
-        reflexivity.
 
     * cbn.
       exists t', (fun x => Ret x); split; [auto|]; split.
@@ -1006,51 +1017,43 @@ Proof.
     intros. rewrite H. assumption.
 Qed.
 
-Definition eq_relation {A} (R S : A -> A -> Prop) :=
-  R <2= S /\ S <2= R.
-
 #[global] Instance eutt_EQ_REL_Proper {E} {A} :
-  Proper (eq_relation ==> eutt eq ==> @eutt E A A eq ==> iff) (eutt).
+  Proper (eq_rel ==> @eutt E A A eq ==> @eutt E A A eq ==> iff) (eutt).
 Proof.
   repeat red.
   intros; split; intros.
   -  rewrite <- H0. rewrite <- H1.
      clear H0 H1.
      destruct H.
-     eapply eqit_mon; eauto.
+     eapply eqit_mono; eauto.
   - rewrite H0, H1.
     destruct H.
-    eapply eqit_mon; eauto.
+    eapply eqit_mono; eauto.
 Qed.
 
 Lemma eutt_EQ_REL_Reflexive_ {E} {A} (ta : itree E A) :
-  forall R, (EQ_REL ta) <2= R ->
+  forall R, (EQ_REL ta) <= R ->
   eutt R ta ta.
 Proof.
   revert ta.
-  ginit. gcofix CIH. intros ta HEQ.
-  gstep. red.
-  genobs ta obs.
-  destruct obs.
-  - econstructor. apply HEQ. red. split; auto. rewrite itree_eta. rewrite <- Heqobs. constructor 1. reflexivity.
-  - econstructor. gbase. apply CIH.
-    setoid_rewrite itree_eta in HEQ.
-    destruct (observe ta); inversion Heqobs. subst.
-    assert (Tau t0 ≈ t0) by apply tau_eutt.
-    setoid_rewrite H in HEQ.
-    auto.
-  - econstructor.  intros. red. gbase. apply CIH.
-    intros. apply HEQ.
-    rewrite itree_eta. rewrite <- Heqobs.
-    red in PR. destruct PR.
-    red. split; auto.
-    econstructor 3. reflexivity. apply H0.
+  icoinduction c CIH. intros ta R HEQ.
+  desobs ta hta. 
+  - econstructor. apply HEQ. red. split; auto. 
+    rewrite itree_eta. rewrite hta. now constructor. 
+  - econstructor. apply CIH. intros!. apply HEQ. 
+    red. destruct H. split; auto. 
+    econstructor 2; eauto. 
+  - econstructor; intros. apply CIH. 
+    intros!. apply HEQ.
+    rewrite itree_eta, hta.
+    destruct H.
+    split; auto.
+    econstructor 3; eauto. 
 Qed.
 
 Lemma eutt_EQ_REL_Reflexive {E} {A} (ta : itree E A) : eutt (EQ_REL ta) ta ta.
 Proof.
-  apply eutt_EQ_REL_Reflexive_.
-  auto.
+  now apply eutt_EQ_REL_Reflexive_. 
 Qed.
 
 Definition RET_EQ {E} {A} (ta : itree E A) : A -> A -> Prop :=
diff --git a/extra/ITrace/ITraceBind.v b/extra/ITrace/ITraceBind.v
index 2e1abb6e..621a650a 100644
--- a/extra/ITrace/ITraceBind.v
+++ b/extra/ITrace/ITraceBind.v
@@ -1,4 +1,6 @@
-From Coq Require Import
+From Coinduction Require Import all. 
+
+From Stdlib Require Import
      Morphisms
 .
 
@@ -17,13 +19,12 @@ From ITree.Extra Require Import
      ITrace.ITracePrefix
 .
 
-
-From Paco Require Import paco.
-
 Import Monads.
 Import MonadNotation.
 Local Open Scope monad_scope.
 
+#[local] Tactic Notation "simple_step" := ITree.Basics.Utils.step. 
+
 (* Contains the proof of peel_lemma which allows us
    to decompose a trace of bind t f into a head that refines t and a tail
    that refines f *)
@@ -91,7 +92,7 @@ Lemma refine_ret_vis_contra : forall (E: Type -> Type) (R A: Type)
                                 (r : R) (e : E A) (k : A -> itree E R),
     ~ (Ret r ⊑ Vis e k).
 Proof.
-  intros. intro Hcontra. pinversion Hcontra.
+  intros. intro Hcontra. sinv Hcontra.
 Qed.
 
 (* maybe a better way of doing it is to use strong LEM to see if X = A in the vis case
@@ -102,11 +103,11 @@ Qed.
 Lemma peel_t_ret : forall E R S (b : itrace E S) (t : itree E R) r, t ≅ Ret r -> (peel b t ≅ Ret r).
 Proof.
   intros.  unfold peel.
-  pinversion H; subst; try inv CHECK.
+  sinv H; subst.
   destruct (observe b); cbn; auto.
-  - pfold. red. cbn. constructor. auto.
-  - pfold. red. cbn. constructor; auto.
-  - pfold. red. cbn. simpl. destruct e.
+  - step. cbn. constructor. auto.
+  - step. cbn. constructor; auto.
+  - step. cbn. simpl. destruct e.
     + cbn. constructor. auto.
     + cbn. constructor. auto.
 Qed.
@@ -119,40 +120,38 @@ Lemma peel_refine_t : forall (E : Type -> Type) (R S : Type)
     peel b t ⊑ t.
 Proof.
   intros E R S b t f. generalize dependent b. generalize dependent t.
-  pcofix CIH. intros.
-  punfold Hrutt. red in Hrutt. cbn in Hrutt. pfold. red.
+  icoinduction c CIH. intros.
+  step in Hrutt. cbn in Hrutt. 
   unfold peel.
   destruct (observe t) eqn : Heq.
   - destruct (observe b); cbn; try (constructor; auto).
     destruct e; cbn; constructor; auto.
   - dependent induction Hrutt.
     + exfalso. symmetry in Heq. apply simpobs in Heq. apply simpobs in x.
-      rewrite Heq in x. rewrite bind_tau in x. pinversion x.
-      inv CHECK.
-    + rewrite <- x0. cbn. constructor. right. eapply CIH.
-      pclearbot. symmetry in Heq. apply simpobs in x0.
+      rewrite Heq in x. rewrite bind_tau in x. sinv x.
+    + simpobs. cbn. constructor. eapply CIH.
+       symmetry in Heq. apply simpobs in x0.
       apply simpobs in x. apply simpobs in Heq.
       apply eq_sub_eutt in x0. apply eq_sub_eutt in Heq.
       rewrite tau_eutt in Heq. rewrite tau_eutt in x0.
       rewrite <- Heq. rewrite x. rewrite tau_eutt. auto.
     + exfalso. symmetry in Heq. apply simpobs in Heq.
       apply simpobs in x.
-      rewrite Heq in x. rewrite bind_tau in x. pinversion x.
-      inv CHECK.
-    + rewrite <- x. cbn. constructor. right. eapply CIH.
+      rewrite Heq in x. rewrite bind_tau in x. sinv x.
+    + simpobs. cbn. constructor. eapply CIH.
       clear IHHrutt. symmetry in Heq. apply simpobs in Heq.
       apply eq_sub_eutt in Heq. rewrite tau_eutt in Heq.
-      rewrite <- Heq. pfold. auto.
+      rewrite <- Heq. step. auto.
     + cbn. destruct (observe b) eqn : Heq'.
-      * cbn. rewrite <- Heq'. constructor. right. eapply CIH.
+      * cbn. rewrite <- Heq'. constructor. eapply CIH.
         symmetry in Heq'.
         apply simpobs in Heq'. rewrite Heq'.
         symmetry in Heq. apply simpobs in Heq.
         apply eq_sub_eutt in Heq. rewrite tau_eutt in Heq.
         rewrite <- Heq. apply simpobs in x. rewrite x.
-        rewrite tau_eutt. pfold. auto.
+        rewrite tau_eutt. step. auto.
       * cbn. clear IHHrutt.
-        constructor. right. eapply CIH.
+        constructor. eapply CIH. 
         symmetry in Heq. apply simpobs in Heq.
         apply eq_sub_eutt in Heq. rewrite tau_eutt in Heq.
         rewrite <- Heq.
@@ -160,32 +159,32 @@ Proof.
         rewrite tau_eutt in x. rewrite x.
         enough (Tau t1 ⊑ t2).
         { rewrite tau_eutt in H. auto. }
-        pfold. auto.
+        step. auto.
       * destruct e; cbn.
-        ++ constructor. right. rewrite <- Heq'. clear IHHrutt.
+        ++ constructor. rewrite <- Heq'. clear IHHrutt.
            eapply CIH. symmetry in Heq.
            apply simpobs in Heq. apply eq_sub_eutt in Heq.
            rewrite tau_eutt in Heq. apply simpobs in x.
            apply eq_sub_eutt in x. rewrite tau_eutt in x.
-           rewrite <- Heq. rewrite x. pfold. red.
+           rewrite <- Heq. rewrite x. step. 
            rewrite Heq'. auto.
-        ++ constructor. right. rewrite <- Heq'. clear IHHrutt.
+        ++ constructor. rewrite <- Heq'. clear IHHrutt.
            eapply CIH. symmetry in Heq.
            apply simpobs in Heq. apply eq_sub_eutt in Heq.
            rewrite tau_eutt in Heq. apply simpobs in x.
            apply eq_sub_eutt in x. rewrite tau_eutt in x.
-           rewrite <- Heq. rewrite x. pfold. red.
+           rewrite <- Heq. rewrite x. step. 
            rewrite Heq'. auto.
   - dependent induction Hrutt.
     + exfalso. symmetry in Heq. apply simpobs in Heq. apply simpobs in x.
       rewrite Heq in x. rewrite bind_vis in x.
-      pinversion x.
+      sinv x.
     + exfalso. symmetry in Heq. apply simpobs in Heq. apply simpobs in x.
       rewrite Heq in x. rewrite bind_vis in x.
-      pinversion x; inv CHECK.
-    + rewrite <- x0.
+      sinv x; inv CHECK.
+    + simpobs.
       symmetry in Heq. apply simpobs in Heq. apply simpobs in x.
-      rewrite Heq in x. rewrite bind_vis in x. pinversion x.
+      rewrite Heq in x. rewrite bind_vis in x. step in x; inversion x. 
       ddestruction. inversion H; ddestruction.
       * unfold observe. cbn. unfold peel_vis.
         destruct (classicT (B = B) ); try contradiction.
@@ -193,23 +192,22 @@ Proof.
         remember (eq_sym _) as He. clear HeqHe.
         dependent destruction He. cbn. constructor; eauto.
         intros. inversion H1. ddestruction.
-        apply H0 in H1. pclearbot. unfold id. right. eapply CIH.
-        red in x1. cbn in x1. inversion x1. ddestruction.
+        apply H0 in H1.  unfold id. eapply CIH. 
+        cbn in x1. inversion x1. ddestruction.
         specialize (H0 tt a (rar _ _ _)).
-        specialize (REL0 a). pclearbot.
-        change (paco2 ?x ?y ?t ?u) with (eq_itree eq t u) in REL0.
+        specialize (REL0 a). 
         rewrite REL0. apply H0.
       * cbn. constructor; eauto. intros. contradiction.
-    + rewrite <- x. cbn. constructor. eapply IHHrutt; eauto.
+    + simpobs. cbn. constructor. eapply IHHrutt; eauto.
     + exfalso. symmetry in Heq. apply simpobs in x. apply simpobs in Heq.
       rewrite Heq in x. rewrite bind_vis in x.
-      pinversion x; inv CHECK.
+      sinv x.
 Qed.
 
 Lemma not_spin_eutt_ret : forall E R (r : R), ~ (@ITree.spin E R ≈ Ret r).
 Proof.
   intros. intros Hcontra. specialize (@spin_infinite E R) as Hdiv.
-  rewrite Hcontra in Hdiv. pinversion Hdiv.
+  rewrite Hcontra in Hdiv. sinv Hdiv.
 Qed.
 
 
@@ -217,105 +215,98 @@ Lemma proper_peel_eutt_l : forall (E : Type -> Type) (R S : Type)
                                   (b b': itrace E R) (t : itree E S),
     (b ≈ b') -> (peel b t ≈ peel b' t).
 Proof.
-  intros E R S. pcofix CIH. intros. unfold peel.
+  intros E R S. icoinduction c CIH. intros. unfold peel.
   destruct (observe t).
-  - pfold. red. destruct (observe b); destruct (observe b'); cbn;
+  - destruct (observe b); destruct (observe b'); cbn;
       try (destruct e); try (destruct e0); cbn;
       try (constructor; auto; fail).
-  - pfold. punfold H0. red in H0. dependent induction H0.
-    + rewrite <- x0. rewrite <- x. red. cbn. constructor.
-      right. rewrite x0. eapply CIH. reflexivity.
-    + rewrite <- x0. rewrite <- x. red. cbn. constructor. right.
-      pclearbot. eapply CIH. auto.
-    + rewrite <- x0. rewrite <- x. destruct e; cbn.
-      * red. cbn. constructor. right. rewrite x. rewrite x0.
-        eapply CIH. pfold. red. rewrite <- x. rewrite <- x0.
-        constructor. auto.
-      * red. cbn. constructor. right. rewrite x0. rewrite x.
-        eapply CIH. pfold. red. rewrite <- x0. rewrite <- x.
-        constructor. auto.
+  - step in H. dependent induction H.
+    + simpobs. reflexivity. 
+    + simpobs. cbn. etau. 
+    + simpobs. destruct e; cbn.
+      * constructor. rewrite x, x0.
+        eapply CIH. step. simpobs.
+        evis. 
+      * constructor. rewrite x, x0.
+        eapply CIH. step. simpobs.
+        evis. 
     + destruct (observe b); destruct (observe b'); dependent destruction x.
-      * red. cbn. constructor. right. remember (@go (EvAns E) _ (RetF r0)) as t1.
-        assert (RetF r0 = observe t1).
+      * cbn. constructor. remember (@go (EvAns E) _ (RetF r)) as t1.
+        assert (RetF r = observe t1).
         { rewrite Heqt1. auto. }
-        rewrite H. eapply CIH. rewrite Heqt1. pfold. auto.
-      * red. cbn. constructor. right. eapply CIH.
+        rewrite H0. eapply CIH. rewrite Heqt1. step. auto.
+      * cbn. constructor. eapply CIH. 
         enough (t2 ≈ Tau t3).
-        { rewrite tau_eutt in H. auto. }
-        pfold. auto.
-      * red. destruct e; cbn.
-        ++ constructor. right.
+        { rewrite tau_eutt in H0. auto. }
+        step. auto.
+      * destruct e; cbn.
+        ++ constructor.
            remember (@go (EvAns E) _ (VisF (evans A ev ans) k )  ) as t1.
            assert (VisF (evans A ev ans) k  = observe t1).
            { rewrite Heqt1. auto. }
-           rewrite H. eapply CIH. subst. pfold. auto.
-        ++ constructor. right.
+           rewrite H0. eapply CIH. subst. step. auto.
+        ++ constructor.
            remember (go (VisF (evempty A Hempty ev) k )  ) as t1.
            assert (VisF (evempty A Hempty ev) k = observe t1 ).
            { subst. auto. }
-           rewrite H. eapply CIH. subst. pfold. auto.
+           rewrite H0. eapply CIH. subst. step. auto.
     + destruct (observe b); destruct (observe b'); dependent destruction x.
-      * red. cbn. constructor. right. remember (@go (EvAns E) _ (RetF r0)) as t2.
-        assert (RetF r0 = observe t2).
+      * cbn. constructor. remember (@go (EvAns E) _ (RetF r)) as t2.
+        assert (RetF r = observe t2).
         { subst. auto. }
-        rewrite H. eapply CIH. rewrite Heqt2. pfold. auto.
-      * red. cbn. constructor. right. eapply CIH.
+        rewrite H0. eapply CIH. rewrite Heqt2. step. auto.
+      * cbn. constructor. eapply CIH. 
         enough (Tau t1 ≈ t3).
-        { rewrite tau_eutt in H. auto. }
-        pfold. auto.
-      * red. destruct e; cbn.
-        ++ constructor. right.
+        { rewrite tau_eutt in H0. auto. }
+        step. auto.
+      * destruct e; cbn.
+        ++ constructor. 
            remember (@go (EvAns E) _ (VisF (evans A ev ans) k )  ) as t2.
            assert (VisF (evans A ev ans) k  = observe t2).
            { subst. auto. }
-           rewrite H. eapply CIH. subst. pfold. auto.
-        ++ constructor. right.
+           rewrite H0. eapply CIH. subst. step. auto.
+        ++ constructor. 
            remember (go (VisF (evempty A Hempty ev) k )  ) as t2.
            assert (VisF (evempty A Hempty ev) k = observe t2 ).
            { subst. auto. }
-           rewrite H. eapply CIH. subst. pfold. auto.
-  - pfold. punfold H0. red in H0. dependent induction H0.
-    + rewrite <- x0. rewrite <- x. red. cbn. constructor.
-      left. apply pacobot2.
-      enough (@ITree.spin (EvAns E) S  ≈ ITree.spin); auto.
-      reflexivity.
-    + rewrite <- x. rewrite <- x0. red. cbn. constructor. right.
+           rewrite H0. eapply CIH. subst. step. auto.
+  - step in H. dependent induction H.
+    + simpobs. reflexivity.
+    + simpobs. cbn. constructor.
       remember (go (VisF e k) ) as t0.
       assert (VisF e k = observe t0).
       { subst. auto. }
-      rewrite H. eapply CIH. pclearbot. auto.
-    + rewrite <- x0. rewrite <- x. red. destruct e; cbn.
+      rewrite H. eapply CIH.  auto.
+    + simpobs. destruct e; cbn.
       * unfold observe. cbn. unfold peel_vis.
         destruct (classicT (A = X) ).
         ++ unfold eq_rect_r, eq_rect. remember (eq_sym e) as He.
            dependent destruction He. cbn. constructor. intros.
-           right. eapply CIH. pclearbot. auto with itree.
-        ++ cbn. constructor. left. apply pacobot2.
-           enough (@ITree.spin (EvAns E) S ≈ ITree.spin ); auto.
-           reflexivity.
-      * constructor. left. contradiction.
-    + rewrite <- x. red. destruct (observe b') eqn : Heq.
+           eapply CIH.   auto with itree.
+        ++ reflexivity.
+      * constructor. contradiction.
+    + simpobs. destruct (observe b') eqn : Heq.
       * rewrite <- Heq. cbn. constructor; auto. eapply IHeqitF; eauto. rewrite Heq. auto.
-      * cbn. constructor. right.
+      * cbn. constructor.
         remember (go (VisF e k) ) as t2.
         assert (VisF e k = observe t2).
         { subst. auto. }
-        rewrite H. eapply CIH.
+        rewrite H0. eapply CIH.
         enough (t1 ≈ Tau t0).
         { rewrite tau_eutt in H1. auto. }
-        pfold; auto.
+        step; auto.
       * cbn. constructor; eauto. rewrite <- Heq. eapply IHeqitF; eauto.
         rewrite Heq. auto.
-    + rewrite <- x. red. destruct (observe b) eqn : Heq.
+    + simpobs. destruct (observe b) eqn : Heq.
       * rewrite <- Heq. cbn. constructor; auto. eapply IHeqitF; eauto. rewrite Heq. auto.
-      * cbn. constructor. right.
+      * cbn. constructor.
         remember (go (VisF e k) ) as t1.
         assert (VisF e k = observe t1).
         { subst. auto. }
-        rewrite H. eapply CIH.
+        rewrite H0. eapply CIH.
         enough (Tau t0 ≈ t2).
         { rewrite tau_eutt in H1. auto. }
-        pfold; auto.
+        step; auto.
       * cbn. constructor; eauto. rewrite <- Heq. eapply IHeqitF; eauto.
         rewrite Heq. auto.
 Qed.
@@ -326,113 +317,111 @@ Lemma proper_peel_eutt_r : forall (E : Type -> Type) (R S : Type)
                                   (b: itrace E R) (t t': itree E S),
     (t ≈ t') -> (peel b t ≈ peel b t').
 Proof.
-  intros E R S. pcofix CIH. intros.
-  pfold. red. unfold peel. destruct (observe b) eqn : Heqb.
-  - punfold H0. red in H0. dependent induction H0.
-    + rewrite <- x. rewrite <- x0.  cbn. constructor. auto.
-    + rewrite <- x. rewrite <- x0. cbn. constructor. right. rewrite <- Heqb.
-      eapply CIH. pclearbot. auto.
-    + rewrite <- x0. rewrite <- x. cbn. constructor.
-      left. apply paco2_eqit_refl.
-    + rewrite <- x.  cbn. constructor; auto. eapply IHeqitF; eauto.
-    + rewrite <- x. cbn. constructor; auto. eapply IHeqitF; eauto.
-  - punfold H0. red in H0. dependent induction H0.
-    + rewrite <- x. rewrite <- x0. cbn. constructor. auto.
-    + rewrite <- x0. rewrite <- x. cbn. constructor. right.
-      pclearbot. eapply CIH; auto.
-    + rewrite <- x0. rewrite <- x. cbn. constructor. right.
-      rewrite x0. rewrite x. eapply CIH.
-      pfold. red. rewrite <- x0. rewrite <- x.
+  intros E R S. coinduction c CIH. intros.
+  unfold peel. destruct (observe b) eqn : Heqb.
+  - step in H. dependent induction H.
+    + simpobs. reflexivity.
+    + simpobs. cbn. constructor. rewrite <- Heqb.
+      eapply CIH.  auto.
+    + simpobs. cbn. reflexivity.
+    + simpobs. cbn. constructor; auto. eapply IHeqitF; eauto.
+    + simpobs. cbn. constructor; auto. eapply IHeqitF; eauto.
+  - step in H. dependent induction H.
+    + simpobs. cbn. constructor. auto.
+    + simpobs. cbn. etau. 
+    + simpobs. cbn. constructor.
+      rewrite x, x0.   eapply CIH.
+      step. simpobs. 
       constructor. auto.
-    + rewrite <- x. destruct (observe t') eqn : Heqt'.
+    + simpobs. destruct (observe t') eqn : Heqt'.
       * cbn.  constructor; auto. clear IHeqitF.
-        dependent induction H0.
-        ++ rewrite <- x. destruct (observe t0); cbn; try (constructor; auto; fail).
+        dependent induction H.
+        ++ simpobs. destruct (observe t0); cbn; try (constructor; auto; fail).
            destruct e; cbn; constructor; auto.
-        ++ rewrite <- x. cbn. destruct (observe t2) eqn : Heqt2; cbn.
+        ++ simpobs. cbn. destruct (observe t2) eqn : Heqt2; cbn.
            ** constructor; eauto. rewrite <- Heqt2.  eapply IHeqitF; eauto.
            ** constructor; auto. eapply IHeqitF; eauto.
            ** destruct e; cbn;
                 try (constructor; auto; rewrite <- Heqt2; eapply IHeqitF; eauto).
-      * cbn. constructor. right. eapply CIH; eauto.
+      * cbn. constructor. eapply CIH; eauto.
         enough (t1 ≈ Tau t2).
-        { rewrite tau_eutt in H. auto. }
-        pfold. auto.
-      * cbn. constructor. rewrite <- Heqt'. right. eapply CIH.
-        pfold. red. rewrite Heqt'. auto.
-    + rewrite <- x. destruct (observe t).
+        { rewrite tau_eutt in H0. auto. }
+        step. auto.
+      * cbn. constructor. rewrite <- Heqt'. eapply CIH. 
+        step. rewrite Heqt'. auto.
+    + simpobs. destruct (observe t).
       * cbn. constructor; auto. clear IHeqitF.
-        dependent induction H0.
-        ++ rewrite <- x. destruct (observe t0); try (destruct e); cbn; constructor; auto.
-        ++ rewrite <- x. destruct (observe t1) eqn : Heqt1; cbn.
+        dependent induction H.
+        ++ simpobs. destruct (observe t0); try (destruct e); cbn; constructor; auto.
+        ++ simpobs. destruct (observe t1) eqn : Heqt1; cbn.
            ** constructor; auto. rewrite <- Heqt1. eapply IHeqitF; eauto.
            ** constructor; auto. eapply IHeqitF; eauto.
            ** destruct e; cbn; try (constructor; auto; rewrite <- Heqt1; eapply IHeqitF; eauto).
-      * cbn. constructor. right. eapply CIH; eauto.
-        rewrite <- tau_eutt at 1. pfold. auto.
-      * cbn. constructor. right. remember ((Vis e k) ) as t1.
+      * cbn. constructor. eapply CIH; eauto.
+        rewrite <- tau_eutt at 1. step. auto.
+      * cbn. constructor. remember ((Vis e k) ) as t1.
         assert (VisF e k = observe t1).
         { subst. auto. }
-        rewrite H. eapply CIH. subst. pfold. auto.
-  - punfold H0. red in H0. dependent induction H0.
-    + rewrite <- x. rewrite <- x0. destruct e; cbn; constructor; auto.
-    + rewrite <- x. rewrite <- x0. destruct e; cbn; constructor; right; rewrite <- Heqb;
-        eapply CIH; pclearbot; eauto.
-    + rewrite <- x. rewrite <- x0. destruct e0; cbn.
+        rewrite H0. eapply CIH. subst. step. auto.
+  - step in H. dependent induction H.
+    + simpobs. destruct e; cbn; constructor; auto.
+    + simpobs. destruct e; cbn; constructor; rewrite <- Heqb;
+        eapply CIH;  eauto.
+    + simpobs. destruct e0; cbn.
       * unfold observe. cbn. unfold peel_vis.
         destruct (classicT (A = u) ).
         ++ unfold eq_rect_r, eq_rect. remember (eq_sym e0) as He.
            dependent destruction He. cbn. constructor. intros.
-           right. eapply CIH. pclearbot. auto with itree.
-        ++ cbn. constructor. left. apply paco2_eqit_refl.
+           eapply CIH.   auto with itree.
+        ++ cbn. reflexivity. 
       * constructor. contradiction.
-    + rewrite <- x. destruct (observe t'); destruct e; cbn.
-      * constructor; auto. clear IHeqitF. dependent induction H0.
-        ++ rewrite <- x. cbn. constructor; auto.
-        ++ rewrite <- x. cbn. constructor; eauto.
-      * constructor; auto. clear IHeqitF. dependent induction H0.
-        ++ rewrite <- x. cbn. constructor; auto.
-        ++ rewrite <- x. cbn. constructor; eauto.
-      * constructor. rewrite <- Heqb. right. eapply CIH.
-        setoid_rewrite <- tau_eutt at 2. pfold. auto.
-      * rewrite <- Heqb. constructor. right. eapply CIH.
-        setoid_rewrite <- tau_eutt at 2. pfold. auto.
+    + simpobs. destruct (observe t'); destruct e; cbn.
+      * constructor; auto. clear IHeqitF. dependent induction H.
+        ++ simpobs. cbn. constructor; auto.
+        ++ simpobs. cbn. constructor; eauto.
+      * constructor; auto. clear IHeqitF. dependent induction H.
+        ++ simpobs. cbn. constructor; auto.
+        ++ simpobs. cbn. constructor; eauto.
+      * constructor. rewrite <- Heqb. eapply CIH. 
+        setoid_rewrite <- tau_eutt at 2. step. auto.
+      * rewrite <- Heqb. constructor. eapply CIH. 
+        setoid_rewrite <- tau_eutt at 2. step. auto.
       * constructor; auto. clear IHeqitF.
-        dependent induction H0.
-        ++ rewrite <- x. unfold observe. cbn.
+        dependent induction H.
+        ++ simpobs. unfold observe. cbn.
            unfold peel_vis. destruct (classicT (A = X0) ).
            ** unfold eq_rect_r, eq_rect.
               remember (eq_sym e) as He. dependent destruction He.
-              cbn. constructor. intros. right. pclearbot. eapply CIH; eauto with itree.
-           ** cbn. constructor. left. apply paco2_eqit_refl.
-        ++ rewrite <- x. cbn. constructor; auto; eapply IHeqitF; eauto.
+              cbn. constructor. intros.  eapply CIH; eauto with itree.
+           ** cbn. reflexivity. 
+        ++ simpobs. cbn. constructor; auto; eapply IHeqitF; eauto.
       * constructor; auto. clear IHeqitF.
-        dependent induction H0.
-        ++ rewrite <- x. cbn. constructor. contradiction.
-        ++ rewrite <- x. cbn. constructor; auto; eapply IHeqitF; eauto.
-    + rewrite <- x. cbn. destruct (observe t) eqn : Heqt; destruct e; cbn.
-      * constructor; auto. clear IHeqitF. dependent induction H0.
-        ++ rewrite <- x. cbn. constructor; auto.
-        ++ rewrite <- x. cbn. constructor; eauto.
-      * constructor; auto. clear IHeqitF. dependent induction H0.
-        ++ rewrite <- x. cbn. constructor; auto.
-        ++ rewrite <- x. cbn. constructor; eauto.
-      * constructor. right. rewrite <- Heqb. eapply CIH; eauto. rewrite <- tau_eutt.
-        pfold. auto.
-      * constructor. rewrite <- Heqb. right. eapply CIH; eauto. rewrite <- tau_eutt.
-        pfold. auto.
-      * constructor; auto. clear IHeqitF. dependent induction H0.
-        ++ rewrite <- x. unfold observe. cbn.
+        dependent induction H.
+        ++ simpobs. cbn. constructor. contradiction.
+        ++ simpobs. cbn. constructor; auto; eapply IHeqitF; eauto.
+    + simpobs. cbn. destruct (observe t) eqn : Heqt; destruct e; cbn.
+      * constructor; auto. clear IHeqitF. dependent induction H.
+        ++ simpobs. cbn. constructor; auto.
+        ++ simpobs. cbn. constructor; eauto.
+      * constructor; auto. clear IHeqitF. dependent induction H.
+        ++ simpobs. cbn. constructor; auto.
+        ++ simpobs. cbn. constructor; eauto.
+      * constructor. rewrite <- Heqb. eapply CIH; eauto. rewrite <- tau_eutt.
+        step. auto.
+      * constructor. rewrite <- Heqb. eapply CIH; eauto. rewrite <- tau_eutt.
+        step. auto.
+      * constructor; auto. clear IHeqitF. dependent induction H.
+        ++ simpobs. unfold observe. cbn.
            unfold peel_vis.
            destruct (classicT (A = X0) ).
            ** unfold eq_rect_r, eq_rect.
               remember (eq_sym e) as He. dependent destruction He.
-              cbn. constructor. intros. right. pclearbot. eapply CIH; apply REL.
-           ** cbn. constructor. left. apply paco2_eqit_refl.
-        ++ rewrite <- x. cbn. constructor; eauto.
-      * constructor; auto. clear IHeqitF. dependent induction H0.
-        ++ rewrite <- x. cbn. constructor. contradiction.
-        ++ rewrite <- x. cbn. constructor; eauto.
+              cbn. constructor. intros.  eapply CIH; apply REL.
+           ** cbn. reflexivity. 
+        ++ simpobs. cbn. constructor; eauto.
+      * constructor; auto. clear IHeqitF. dependent induction H.
+        ++ simpobs. cbn. constructor. contradiction.
+        ++ simpobs. cbn. constructor; eauto.
 Qed.
 
 #[global] Instance proper_eutt_peel {E R S} : Proper (eutt eq ==> eutt eq ==> eutt eq) (@peel E R S).
@@ -446,7 +435,7 @@ Lemma not_peel_vis_ret: forall (R : Type) (E : Type -> Type) (S X : Type) (e : E
     ~ (peel t1 (Vis e k) ≈ Ret r).
 Proof.
   intros R E S X e k r t1 Heutt.
-  punfold Heutt. unfold peel in *. red in Heutt. cbn in *.
+  step in Heutt. unfold peel in *. cbn in *.
   dependent induction  Heutt.
   - destruct (observe t1); cbn in x; try discriminate.
     destruct e0; cbn in *; try discriminate.
@@ -456,7 +445,7 @@ Proof.
     dependent destruction He. discriminate.
   - destruct (observe t1); cbn in x; try discriminate.
     + injection x as Hspin. rewrite Hspin in Heutt.
-      eapply not_spin_eutt_ret. pfold. eauto.
+      eapply not_spin_eutt_ret. step. eauto.
     + injection x as Ht0. eapply IHHeutt; eauto. rewrite Ht0. reflexivity.
     + destruct e0; cbn in *; try discriminate.
       unfold observe in x. cbn in x. unfold peel_vis in *.
@@ -464,7 +453,7 @@ Proof.
       * unfold eq_rect_r, eq_rect in x. remember (eq_sym e0) as He.
         dependent destruction He. discriminate.
       * cbn in x. injection x as Hspin. rewrite Hspin in Heutt.
-        eapply not_spin_eutt_ret. pfold. eauto.
+        eapply not_spin_eutt_ret. step. eauto.
 Qed.
 
 Lemma peel_ret_inv:
@@ -472,7 +461,7 @@ Lemma peel_ret_inv:
     (peel b t ≈ Ret r) -> (t ≈ Ret r).
 Proof.
   intros R r E S b t H. unfold peel in H.
-  punfold H. red in H. cbn in H. pfold. red. cbn.
+  step in H. cbn in H. step. cbn.
   dependent induction H.
   - unfold peel in x. destruct (observe b); destruct (observe t); cbn in *;
       dependent destruction x; try (constructor; auto; fail).
@@ -486,19 +475,19 @@ Proof.
       * discriminate.
   - destruct (observe b); destruct (observe t); cbn in x; dependent destruction x.
     + constructor; auto. eapply IHeqitF with (b := Ret r0); eauto.
-    + exfalso. eapply not_spin_eutt_ret. pfold. eauto.
+    + exfalso. eapply not_spin_eutt_ret. step. eauto.
     + constructor; auto. eapply IHeqitF; eauto.
     + exfalso. destruct (observe t0).
       * cbn in H. eapply not_spin_eutt_ret.
-        inv  H. pfold. eauto.
+        inv  H. step. eauto.
       * cbn in H. inv H. eapply not_peel_vis_ret.
-        pfold. eauto.
+        step. eauto.
       * destruct e0.
         ++ clear IHeqitF. unfold observe in H. cbn in H. unfold peel_vis in H.
            destruct (classicT (A = X) ).
            ** unfold eq_rect_r, eq_rect in H. remember (eq_sym e0) as He.
               dependent destruction He. inv H.
-           ** eapply not_spin_eutt_ret. pfold. eauto.
+           ** eapply not_spin_eutt_ret. step. eauto.
         ++ cbn in H. inv H.
     + destruct e; cbn in x; try discriminate.
     + constructor; auto. eapply IHeqitF with (b := Vis e k); eauto. cbn.
@@ -510,54 +499,31 @@ Proof.
         dependent destruction He. discriminate.
       * injection x as Hspin. cbn in Hspin. exfalso.
         assert (t1 ≈ Ret r).
-        { pfold. auto. }
+        { step. auto. }
         rewrite Hspin in H0. eapply not_spin_eutt_ret; eauto.
 Qed.
 
-Lemma eqitF_r_refl: forall (E : Type -> Type) (R: Type) r
-                           (ot: itree' E R),
-    eqitF eq true true id (upaco2 (eqit_ eq true true id) r)
-          ot ot.
-Proof.
-  intros E R r ot.
-  destruct ot; constructor; auto.
-  - left. apply pacobot2, reflexivity.
-  - left. apply pacobot2, reflexivity.
-Qed.
-
-Lemma eqitF_mon:
-  forall (E : Type -> Type) (R : Type) (r : itree (EvAns E) R -> itree (EvAns E) R -> Prop)
-         (t1 : itree' (EvAns E) R) (t0 : itree' (EvAns E) R),
-    eqitF eq true true id (upaco2 (eqit_ eq true true id) bot2) t1 t0 ->
-    eqitF eq true true id (upaco2 (eqit_ eq true true id) r) t1 t0.
-Proof.
-  intros E R r t1 t0' REL.
-  induction REL; constructor; eauto.
-  - pclearbot. left. apply pacobot2; auto.
-  - pclearbot. intros. left. apply pacobot2; auto.
-Qed.
-
 Lemma eqitF_observe_peel_cont_vis:
   forall (E : Type -> Type) (R S A : Type) (ev : E A) (ans : A)
          (k1 k2 : unit -> itree (EvAns E) R),
-    (forall v : unit, id (upaco2 (eqit_ eq true true id) bot2) (k1 v) (k2 v)) ->
-    forall r : itree (EvAns E) R -> itree (EvAns E) R -> Prop,
+    (forall v : unit, eutt eq (k1 v) (k2 v)) ->
+    forall c : Chain (eqit_mon true true),
       (forall (b b' : itrace E R) (t : itree E S),
           (b ≈ b') ->
-          r (peel_cont_ (observe b) (observe t)) (peel_cont_ (observe b') (observe t))) ->
+          elem c _ _ eq (peel_cont_ (observe b) (observe t)) (peel_cont_ (observe b') (observe t))) ->
       forall (X : Type) (e : E X) (k : X -> itree E S),
-        eqitF eq true true id (upaco2 (eqit_ eq true true id) r)
-              (observe (peel_cont_ (VisF (evans A ev ans) k1) (VisF e k)))
-              (observe (peel_cont_ (VisF (evans A ev ans) k2) (VisF e k))).
+        eqit_mon true true (elem c) _ _ eq
+              ((peel_cont_ (VisF (evans A ev ans) k1) (VisF e k)))
+              ((peel_cont_ (VisF (evans A ev ans) k2) (VisF e k))).
 Proof.
-  intros E R S A ev ans k1 k2 REL r CIH X e k.
+  intros E R S A ev ans k1 k2 REL c CIH X e k. icbn. 
   unfold observe. cbn. unfold peel_cont_vis.
   destruct (classicT (A = X) ).
   - unfold eq_rect_r, eq_rect. remember (eq_sym e0) as He.
     dependent destruction He. cbn. constructor.
-    intros. right. pclearbot. eapply CIH. auto with itree.
-  - cbn. apply eqitF_r_refl.
-Qed.
+    intros.  eapply CIH. auto with itree.
+  - cbn. taus. reflexivity. 
+Qed.  
 
 
 Lemma proper_peel_cont_eutt_l : forall (E : Type -> Type) (R S : Type)
@@ -565,69 +531,62 @@ Lemma proper_peel_cont_eutt_l : forall (E : Type -> Type) (R S : Type)
     (b ≈ b') -> (peel_cont b t s ≈ peel_cont b' t s).
 Proof.
   intros E R S. unfold peel_cont. intros b b' t _.
-  revert b b' t. pcofix CIH. intros. pfold. punfold H0. red in H0.
+  revert b b' t. icoinduction c CIH. intros. step in H. 
   destruct (observe t) eqn : Heqt.
-  - red. destruct (observe b') eqn : Hb; destruct (observe b) eqn : Hb'; inversion H0; cbn;
-      try (constructor; auto; fail);
-      try (constructor; auto; eapply eqitF_mon; eauto; fail);
-      try (destruct e; cbn);
-      try (constructor; auto; eapply eqitF_mon; eauto; fail).
-    + constructor. pclearbot. left. apply pacobot2; auto.
-    + subst. ddestruction. subst. cbn. constructor. intros. left. inv H0.
-      ddestruction. subst. pclearbot. apply pacobot2; auto.
-    + ddestruction. subst. ddestruction. subst. cbn. constructor; auto. intros [].
+  (* todo: this *)
+  - destruct (observe b') eqn : Hb; destruct (observe b) eqn : Hb'; inversion H; subst; cbn;
+      try solve [to_mon; constructor; eauto; now do 2 step]. 
+    + taus. now do 2 Utils.step.  
+      + ddestruction. constructor. intros. inv H. 
+      ddestruction. do 2 Utils.step. apply REL0. 
   (*looks like I didn't actually need to induct here ... *)
-  - dependent induction H0; try clear IHeqitF.
-    + rewrite <- x0. rewrite <- x. red. cbn. constructor. right.
-      rewrite x. eapply CIH; eauto. pfold. red. rewrite <- x. constructor; auto.
-    + rewrite <- x0. rewrite <- x. red. cbn. constructor. right.
-      eapply CIH. pclearbot. auto.
-    + rewrite <- x0. rewrite <- x. red. destruct e; cbn; constructor; right.
-      * rewrite x. rewrite x0. eapply CIH; eauto. pfold. red.
-        rewrite <- x0. rewrite <- x. constructor. auto.
-      * rewrite x. rewrite x0. eapply CIH; eauto. pfold. red.
-        rewrite <- x0. rewrite <- x. constructor. auto.
-    + rewrite <- x. red. cbn.
+  - dependent induction H; try clear IHeqitF.
+    + simpobs. cbn. etau.    
+    + simpobs. cbn. etau. 
+    + simpobs. destruct e; cbn; constructor. 
+      * simpobs. rewrite x, x0. eapply CIH; eauto. step.
+        simpobs. constructor. auto.
+      * rewrite x, x0. eapply CIH; eauto. step. 
+        simpobs. constructor. auto.
+    + simpobs.  cbn.
       destruct (observe b') eqn : Heqb'; cbn.
-      * constructor. right. rewrite <- Heqb'. eapply CIH.
+      * constructor. rewrite <- Heqb'. eapply CIH.
         symmetry in Heqb'. apply simpobs in Heqb'. rewrite Heqb'.
-        pfold. auto.
-      * constructor. right. eapply CIH. setoid_rewrite <- tau_eutt at 2.
-        pfold. auto.
-      * constructor. right. rewrite <- Heqb'. eapply CIH.
-        symmetry in Heqb'. apply simpobs in Heqb'. rewrite Heqb'. pfold. auto.
-    + rewrite <- x. red. cbn. destruct (observe b) eqn : Heqb; cbn.
-      * constructor; auto. right. rewrite <- Heqb. eapply CIH.
-        pfold. red. rewrite Heqb. auto.
-      * constructor. right. eapply CIH. rewrite <- tau_eutt at 1. pfold. auto.
-      * constructor. right. rewrite <- Heqb. eapply CIH. pfold.
-        red. rewrite Heqb. auto.
-  - red. dependent induction H0; cbn.
-    +  rewrite <- x0. rewrite <- x. cbn. constructor. left. pfold. apply eqitF_r_refl.
-    + rewrite <- x0. rewrite <- x. cbn. constructor. right. rewrite <- Heqt. eapply CIH.
-      pclearbot. auto.
-    + rewrite <- x. rewrite <- x0. destruct e; cbn; try (apply eqitF_observe_peel_cont_vis; auto).
-      apply eqitF_r_refl.
-    + rewrite <- x. cbn. constructor; eauto.
-    + rewrite <- x. cbn. constructor; eauto.
+        step. auto.
+      * constructor. eapply CIH.  setoid_rewrite <- tau_eutt at 2.
+        step. auto.
+      * constructor. rewrite <- Heqb'. eapply CIH.
+        symmetry in Heqb'. apply simpobs in Heqb'. rewrite Heqb'. step. auto.
+    + simpobs. cbn. destruct (observe b) eqn : Heqb; cbn.
+      * constructor; auto. rewrite <- Heqb. eapply CIH.
+        step. rewrite Heqb. auto.
+      * constructor. eapply CIH.  rewrite <- tau_eutt at 1. step. auto.
+      * constructor. rewrite <- Heqb. eapply CIH. step.
+        rewrite Heqb. auto.
+  - dependent induction H; cbn.
+    +  simpobs. simpobs. cbn. reflexivity. 
+    + simpobs. simpobs. cbn. constructor. rewrite <- Heqt. eapply CIH.
+       auto.
+    + simpobs. destruct e; cbn; try (apply eqitF_observe_peel_cont_vis; auto).
+      reflexivity. 
+    + simpobs. cbn. constructor; eauto.
+    + simpobs. cbn. constructor; eauto.
 Qed.
 
 Lemma peel_cont_ret_inv : forall E R S (b : itrace E R) (t : itree E S) (s : S),
     t ≈ Ret s -> (peel_cont_ (observe b) (observe t) ≈ b).
 Proof.
-  intros E R S. pcofix CIH. intros. punfold H0. red in H0. cbn in H0. dependent induction H0; subst.
-  - rewrite <- x. cbn. pfold. red. cbn. apply eqitF_r_refl.
-  - rewrite <- x. destruct (observe b) eqn : Hb.
-    + pfold. red. cbn. constructor; auto.
-
-      specialize (IHeqitF r CIH (Ret r0) t1 s ); auto.
-      assert (S = S). auto. apply IHeqitF in H; auto. rewrite Hb.
-      punfold H.
-    + pfold. red. rewrite Hb. cbn.   constructor. right. eapply CIH with (s := s).
-      pfold. auto.
-    + pfold. red. rewrite Hb. cbn. rewrite <- Hb. constructor; auto.
-      specialize (IHeqitF r CIH b t1 s ); auto.
-      assert (S = S). auto. apply IHeqitF in H; auto. punfold H.
+  intros E R S. coinduction c CIH. intros. step in H. cbn in H. dependent induction H; subst.
+  - simpobs. cbn. reflexivity. 
+  - simpobs. destruct (observe b) eqn : Hb.
+    + cbn. taul. simpobs. to_mon. 
+      rewrite <- itree_eta. 
+      specialize (IHeqitF CIH (Ret r) t1 s ); auto.
+    + cbn. rewrite Hb. taus. eapply CIH with (s := s).
+      step. auto.
+    + cbn. rewrite Hb. taul. rewrite <- Hb. 
+      specialize (IHeqitF CIH b t1 s ); auto.
+      assert (S = S). auto. apply IHeqitF; auto.
 Qed.
 
 Lemma proper_peel_cont_eutt_r : forall (E : Type -> Type) (R S : Type)
@@ -635,57 +594,58 @@ Lemma proper_peel_cont_eutt_r : forall (E : Type -> Type) (R S : Type)
     (t ≈ t') -> (peel_cont b t s ≈ peel_cont b t' s).
 Proof.
   intros E R S. unfold peel_cont. intros b t t' _.
-  revert b t t'. pcofix CIH. intros. pfold. punfold H0. red in H0. dependent induction H0.
-  - rewrite <- x. rewrite <- x0. red. cbn. apply eqitF_r_refl.
-  - rewrite <- x. rewrite <- x0. red. destruct (observe b) eqn : Heqb; cbn.
-    + constructor. right. rewrite <- Heqb. eapply CIH. pclearbot. auto.
-    + constructor. right. eapply CIH. pclearbot. auto.
-    + constructor. right. rewrite <- Heqb. eapply CIH; pclearbot; auto.
-  - rewrite <- x. rewrite <- x0. pclearbot. destruct (observe b) eqn : Heqb; red; cbn.
-    + apply eqitF_r_refl.
-    + constructor. rewrite x. rewrite x0. right. eapply CIH.
-      pfold. red. rewrite <- x. rewrite <- x0. constructor. intros.
-      left. auto.
+  revert b t t'. coinduction c CIH. intros. step in H. dependent induction H.
+  - simpobs. reflexivity. 
+  - simpobs. destruct (observe b) eqn : Heqb; cbn.
+    + cbn. taus. rewrite <- Heqb. eapply CIH. auto.
+    + etau. 
+    + constructor. rewrite <- Heqb. eapply CIH; auto.
+  - simpobs.  destruct (observe b) eqn : Heqb; red; cbn.
+    + reflexivity. 
+    + constructor. rewrite x, x0. eapply CIH. 
+      step. simpobs. constructor. intros.
+      auto.
     + destruct e0; cbn.
       * unfold observe. cbn. unfold peel_cont_vis.
-        destruct (classicT (A = u) ); try apply eqitF_r_refl.
+        destruct (classicT (A = u) ); try reflexivity.
         unfold eq_rect_r, eq_rect. remember (eq_sym e0) as He.
-        dependent destruction He. cbn. constructor. intros. right.
+        dependent destruction He. cbn. constructor. intros.
         eapply CIH. auto with itree.
-      * apply eqitF_r_refl.
-  - rewrite <- x. destruct (observe b) eqn : Heqb; red; cbn.
+      * reflexivity. 
+  - simpobs. destruct (observe b) eqn : Heqb; red; cbn.
     + constructor; eauto. rewrite <- Heqb. eapply IHeqitF; eauto.
     + cbn. destruct (observe t') eqn : Heqt'; cbn.
-      * constructor. left. apply pacobot2.
-        eapply peel_cont_ret_inv with (s := r0). pfold. auto.
-      * constructor. right. eapply CIH; eauto. setoid_rewrite <- tau_eutt at 2.
-        pfold. auto.
-      * constructor. right. rewrite <- Heqt'. eapply CIH.
-        pfold. red. rewrite Heqt'. auto.
+      * constructor.  Utils.step.  
+        unstep in H. eapply peel_cont_ret_inv with (b := t0) in H. step.
+        rewrite H. reflexivity. 
+      * constructor. eapply CIH; eauto. setoid_rewrite <- tau_eutt at 2.
+        step. auto.
+      * constructor. rewrite <- Heqt'. eapply CIH.
+        step. rewrite Heqt'. auto.
     + rewrite <- Heqb. constructor; auto. eapply IHeqitF; eauto.
-  - rewrite <- x. destruct (observe b) eqn : Heqb; red; cbn.
+  - simpobs. destruct (observe b) eqn : Heqb; red; cbn.
     + constructor; auto. rewrite <- Heqb. eapply IHeqitF; eauto.
     + destruct (observe t) eqn : Heqt; cbn.
-      * constructor. left. apply pacobot2.
-        enough (t0 ≈ peel_cont_ (observe t0) (observe t2) ). auto.
-        symmetry.
-        eapply peel_cont_ret_inv with (s := r0). symmetry. pfold. auto.
-      * constructor. right. eapply CIH. rewrite <- tau_eutt at 1. pfold. auto.
-      * constructor. right. rewrite <- Heqt. eapply CIH.
-        pfold. red. rewrite Heqt. auto.
+      *
+      symmetry in H. unstep in H. 
+      eapply peel_cont_ret_inv with (b := t0) in H. cbn in H. 
+      taus. symmetry. now do 2 Utils.step. 
+      * constructor. eapply CIH.  rewrite <- tau_eutt at 1. step. auto.
+      * constructor. rewrite <- Heqt. eapply CIH.
+        step. rewrite Heqt. auto.
     + rewrite <- Heqb. constructor; auto. eapply IHeqitF; eauto.
 Qed.
 
 #[global] Instance proper_eutt_peel_cont {E R S} : Proper (eutt eq ==> eutt eq ==> eq ==> eutt eq) (@peel_cont E R S).
 Proof.
   repeat intro. subst. rewrite proper_peel_cont_eutt_l; eauto.
-  rewrite proper_peel_cont_eutt_r; eauto. reflexivity.
+  rewrite proper_peel_cont_eutt_r; eauto.
 Qed.
 (*
 Lemma peel_cont_bind : forall (E : Type -> Type) (R S : Type) (b : itrace E S) (t : itree E R) (f : R -> itree E S),
     b ⊑ ITree.bind t f -> (ITree.bind (peel b t) (peel_cont b t) ≈ b).
 Proof.
-  intros E R S. pcofix CIH. intros. punfold H0. pfold. red. red in H0. cbn in *.
+  intros E R S. coinduction c CIH. intros. step in H0. cbn in *.
   unfold ITree.bind in H0. unfold ITree.bind. cbn in *.
   unfold observe at 1. cbn.
  *)
@@ -695,18 +655,18 @@ Lemma vis_refine_peel : forall (E : Type -> Type) (R S A : Type) (e : E A) (a :
     (peel (Vis (evans _ e a) k1) (Vis e k2) ≈ Vis (evans _ e a) k3) ->
     (k3 tt ≈ peel (k1 tt) (k2 a)).
 Proof.
-  intros E R S A. (* pcofix CIH. *) intros e a k1 k2 k3 Hpeel.
-  unfold peel in *. cbn in *. punfold Hpeel.
-  red in Hpeel. cbn in *. cbn in Hpeel.
+  intros E R S A. (* coinduction c CIH. *) intros e a k1 k2 k3 Hpeel.
+  unfold peel in *. cbn in *. step in Hpeel.
+  cbn in *. 
   unfold observe in Hpeel. cbn in Hpeel.
   unfold peel_vis in Hpeel.
-  assert (A = A). auto.
+  assert (A = A) by auto.
   destruct (classicT (A = A) ); try contradiction. unfold eq_rect_r, eq_rect in Hpeel.
   remember (eq_sym e0) as He. dependent destruction He. cbn in *.
-  clear HeqHe e0 H. pfold. red. cbn. inv Hpeel. ddestruction.
-  pclearbot. specialize (REL tt).
+  clear HeqHe e0 H. step. cbn. inv Hpeel. ddestruction.
+   specialize (REL tt).
   assert (peel_ (observe (k1 tt)) (observe (k2 a)) ≈ k3 tt ). auto.
-  symmetry in H. punfold H.
+  symmetry in H. now step in H.
 Qed.
 
 Lemma vis_refine_peel_cont :  forall (E : Type -> Type) (R S A : Type) (e : E A) (a : A)
@@ -714,13 +674,13 @@ Lemma vis_refine_peel_cont :  forall (E : Type -> Type) (R S A : Type) (e : E A)
     (peel_cont_ (VisF (evans _ e a) k1) (VisF e k2) ≈ t) ->
     (t ≈ peel_cont_ (observe (k1 tt)) (observe (k2 a))).
 Proof.
-  intros E R S A e a k1 k2 t Hpeelcont. punfold Hpeelcont. red in Hpeelcont.
+  intros E R S A e a k1 k2 t Hpeelcont. step in Hpeelcont.
   unfold observe in Hpeelcont at 1. cbn in *. unfold peel_cont_vis in *.
   assert (A = A); auto. destruct (classicT (A = A) ); try contradiction.
   unfold eq_rect_r, eq_rect in *. remember (eq_sym e0) as He.
   dependent destruction He. cbn in *. symmetry.
   assert (Tau (peel_cont_ (observe (k1 tt)) (observe (k2 a) ) )  ≈ t ).
-  { pfold. auto. }
+  { step. auto. }
   rewrite tau_eutt in H0. auto.
 Qed.
 
@@ -728,7 +688,7 @@ Lemma spin_not_vis : forall (E : Type -> Type) (R A : Type)
                             (e : E A) (k : A -> itree E R),
     ~ ITree.spin ≈ Vis e k.
 Proof.
-  intros E R A e k Hcontra. punfold Hcontra. red in Hcontra. cbn in *.
+  intros E R A e k Hcontra. step in Hcontra. cbn in *.
   dependent induction Hcontra.
   eapply IHHcontra; eauto.
 Qed.
@@ -736,7 +696,7 @@ Qed.
 Lemma peel_vis_empty_contra: forall (R : Type) (E : Type -> Type) (S A0 : Type) (Hempty : A0 -> void)
                                     (ev : E A0) (k0 : void -> itree (EvAns E) S) (t0 : itree E R) (A : Type)
                                     (a : A) (e : E A) (k : unit -> itrace E R),
-    eqitF eq true true id (upaco2 (eqit_ eq true true id) bot2)
+    eqitF eq true true (eutt eq)
           (observe (peel_ (VisF (evempty A0 Hempty ev) k0) (observe t0)))
           (VisF (evans A e a) k) -> False.
 Proof.
@@ -754,7 +714,7 @@ Lemma vis_peel_l : forall (E : Type -> Type) (R S A : Type) (e : E A) (a : A)
     (peel b t ≈ Vis (evans _ e a) k) -> exists k', (b ≈ Vis (evans _ e a) k').
 Proof.
   intros E R S A e a b t f k Href Hpeel.
-  punfold Hpeel. red in Hpeel. cbn in Hpeel. dependent induction Hpeel.
+  step in Hpeel. cbn in Hpeel. dependent induction Hpeel.
   - unfold peel in x.
     destruct (observe b) eqn : Heqb; destruct (observe t) eqn : Heqt; try destruct e0; cbn in *;
       dependent destruction x. unfold observe in x. cbn in x.
@@ -765,8 +725,8 @@ Proof.
       symmetry in Heqb. symmetry in Heqt. apply simpobs in Heqb. apply simpobs in Heqt.
       rewrite Heqb in Href. rewrite Heqt in Href.
       rewrite bind_vis in Href.
-      punfold Href. red in Href. cbn in *. inv Href.
-      ddestruction. subst. inv H1. auto.
+      step in Href. cbn in *. inv Href.
+      ddestruction. subst. inv H1. 
     }
     destruct (classicT (A0 = X0)); try (exfalso; auto; fail).
     unfold eq_rect_r, eq_rect in x. remember (eq_sym e0) as He.
@@ -778,7 +738,7 @@ Proof.
     + symmetry in Heqt. apply simpobs in Heqt. rewrite Heqt in Href.
       rewrite tau_eutt in Href. eapply IHHpeel in Href; eauto. unfold peel.
       rewrite Heqb. auto.
-    + exfalso. eapply spin_not_vis. pfold. eauto.
+    + exfalso. eapply spin_not_vis. step. eauto.
     + symmetry in Heqb. symmetry in Heqt. apply simpobs in Heqt.
       apply simpobs in Heqb. setoid_rewrite Heqb. setoid_rewrite tau_eutt.
       rewrite Heqb in Href. rewrite Heqt in Href. repeat rewrite tau_eutt in Href.
@@ -795,7 +755,7 @@ Proof.
     + unfold observe in x. cbn in x. unfold peel_vis in x.
       symmetry in Heqb. symmetry in Heqt. apply simpobs in Heqt.
       apply simpobs in Heqb. rewrite Heqb in Href. rewrite Heqt in Href.
-      rewrite bind_vis in Href. punfold Href. red in Href. cbn in *.
+      rewrite bind_vis in Href. step in Href. cbn in *.
       inv Href. ddestruction. subst. inv H1. subst; ddestruction; subst.
       assert (A0 = A0); auto. destruct (classicT (A0 = A0) ); try contradiction.
       unfold eq_rect_r, eq_rect in *. remember (eq_sym e0) as He.
@@ -809,7 +769,7 @@ Lemma vis_peel_r : forall (E : Type -> Type) (R S A : Type) (e : E A) (a : A)
 Proof.
   intros E R S A e a b t f k Href Hpeel.
   eapply vis_peel_l in Hpeel as Hpeell; eauto. destruct Hpeell as [k' Hb].
-  rewrite Hb in Href. rewrite Hb in Hpeel. clear Hb b. punfold Hpeel. red in Hpeel. cbn in *.
+  rewrite Hb in Href. rewrite Hb in Hpeel. clear Hb b. step in Hpeel. cbn in *.
   unfold peel in Hpeel. cbn in *. dependent induction Hpeel.
   - destruct (observe t) eqn : Heqt; dependent destruction x.
     symmetry in Heqt. apply simpobs in Heqt. setoid_rewrite Heqt.
@@ -817,7 +777,7 @@ Proof.
       cbn in *; try discriminate.
     unfold eq_rect_r, eq_rect in x. remember (eq_sym e1) as He.
     dependent destruction He. cbn in *. exists k0.
-    rewrite Heqt in Href. rewrite bind_vis in Href. punfold Href. red in Href.
+    rewrite Heqt in Href. rewrite bind_vis in Href. step in Href. 
     cbn in *. inv Href. ddestruction; subst. inv H1. ddestruction; subst. reflexivity.
   - destruct (observe t) eqn : Heqt; cbn in *; dependent destruction x.
     + symmetry in Heqt. apply simpobs in Heqt. rewrite Heqt in Href. rewrite tau_eutt in Href.
@@ -827,7 +787,7 @@ Proof.
       * unfold eq_rect_r, eq_rect in x. remember (eq_sym e1) as He. dependent destruction He.
         cbn in *. discriminate.
       * cbn in x. injection x as Ht1. rewrite Ht1 in Hpeel.
-        exfalso. eapply spin_not_vis. pfold. eauto.
+        exfalso. eapply spin_not_vis. step. eauto.
 Qed.
 
 Lemma peel_cont_vis_eutt: forall (R : Type) (r : R) (E : Type -> Type) (S A : Type) (ev : E A)
@@ -835,11 +795,10 @@ Lemma peel_cont_vis_eutt: forall (R : Type) (r : R) (E : Type -> Type) (S A : Ty
     (peel_cont (Vis (evans A ev ans) kb) (Vis ev kt) r ≈ peel_cont (kb tt) (kt ans) r).
 Proof.
   intros R r E S A ev ans kb kt.
-  pfold. cbn. red. unfold observe at 1. cbn in *. unfold peel_cont_vis.
+  step. unfold observe at 1. cbn. unfold peel_cont_vis.
   assert (A = A); auto. destruct (classicT (A = A)); try contradiction.
   unfold eq_rect_r, eq_rect. remember (eq_sym e) as He.
-  dependent destruction He. cbn. constructor; auto. unfold peel_cont.
-  apply eqitF_r_refl.
+  dependent destruction He. cbn. constructor; auto. 
 Qed.
 
 Lemma peel_cont_refine_t : forall (E : Type -> Type) (R S : Type)
@@ -865,15 +824,13 @@ Proof.
     rewrite Hkb in H1. rewrite Htk in H1.
     apply vis_refine_peel in H1 as Hk.
     rewrite peel_cont_vis_eutt. apply IHmay_converge; auto.
-    + rewrite bind_vis in Hrutt. punfold Hrutt. red in Hrutt. cbn in *.
+    + rewrite bind_vis in Hrutt. step in Hrutt. cbn in *.
       inv Hrutt. ddestruction; subst.
       assert (RAnsRef E unit A (evans A ev ans) tt ev ans ); auto with itree.
-      apply H8 in H. pclearbot. auto.
+      apply H8 in H.  auto.
     + destruct b. symmetry. auto.
 Qed.
 
-Ltac fold_eutt := match goal with |- paco2 _ _ ?t1 ?t2 =>
-                                    apply pacobot2; change (t1 ≈ t2); auto end.
 
 Ltac fold_peel_cont r := match goal with |- context [peel_cont_ (observe ?b) (observe ?t) ] =>
                                            assert (Hfpc : forall r, peel_cont_ (observe b) (observe t) = peel_cont b t r ); auto; rewrite (Hfpc r);
@@ -886,7 +843,7 @@ Lemma trace_prefix_tau_ret:
     observe b = RetF r0 ->
     forall t0 : itree E S,
       observe t = TauF t0 ->
-      trace_prefixF (upaco2 trace_prefix_ r) (TauF (peel_ (RetF r0) (observe t0))) (RetF r0).
+      trace_prefixF r (TauF (peel_ (RetF r0) (observe t0))) (RetF r0).
 Proof.
   intros E R S r b t f r0 Hrutt Heqb t0 Heqt.
   symmetry in Heqb. symmetry in Heqt.
@@ -895,22 +852,22 @@ Proof.
   apply trace_refine_ret_inv_r in Hrutt. constructor.
   assert (exists s, t0 ≈ Ret s).
   {
-    punfold Hrutt. red in Hrutt. dependent induction Hrutt.
+    step in Hrutt. dependent induction Hrutt.
     - unfold observe in x. cbn in *. destruct (observe t0) eqn : Ht0; cbn in *; try discriminate.
-      exists r1. pfold. red. rewrite Ht0. cbn. auto with itree.
+      exists r1. step. rewrite Ht0. cbn. auto with itree.
     - unfold observe in x. cbn in *. destruct (observe t0) eqn : Ht0; cbn in *; try discriminate.
-      + exists r1. pfold. red. rewrite Ht0. cbn. auto with itree.
+      + exists r1. step. rewrite Ht0. cbn. auto with itree.
       + injection x as Ht1. symmetry in Ht0. apply simpobs in Ht0.
         apply eq_sub_eutt in Ht0 as Ht0'. setoid_rewrite Ht0'.
         setoid_rewrite tau_eutt. eapply IHHrutt; eauto.
-        rewrite Ht1. eauto. subst. cbn. unfold ITree.bind. reflexivity.
+        rewrite Ht1. eauto.
   }
-  destruct H as [s Ht0]. punfold Ht0. red in Ht0. cbn in Ht0.
+  destruct H as [s Ht0]. step in Ht0. cbn in Ht0.
   clear Heqt Hrutt.
   dependent induction Ht0.
-  - rewrite <- x. cbn. punfold Heqb. red in Heqb. cbn in *. inv Heqb; try inv CHECK.
+  - simpobs. cbn. step in Heqb. cbn in *. inv Heqb.
     rewrite H0. auto with itree.
-  - rewrite <- x. cbn. constructor. eapply IHHt0; eauto.
+  - simpobs. cbn. constructor. eapply IHHt0; eauto.
 Qed.
 
 Lemma trace_prefix_vis_evans: forall (E : Type -> Type) (R S : Type) (r : itrace E S -> itrace E R -> Prop)
@@ -919,26 +876,25 @@ Lemma trace_prefix_vis_evans: forall (E : Type -> Type) (R S : Type) (r : itrace
                                      (t0 : itree E S) (f : S -> itree E R),
     (forall (a : unit) (b : A0),
         RAnsRef E unit A0 (evans A0 ev ans) a ev b ->
-        id
-          (upaco2 (rutt_ (REvRef E) (RAnsRef E) eq)
-                  bot2) (k a) (ITree.bind (k' b) f)) ->
+        rutt (REvRef E) (RAnsRef E) eq
+                 (k a) (ITree.bind (k' b) f)) ->
     (t0 ≈ Vis ev k') ->
     (forall (b : itrace E R) (t : itree E S)
             (f : S -> itree E R),
         b ⊑ ITree.bind t f -> r (peel b t) b) ->
-    trace_prefixF (upaco2 trace_prefix_ r)
+    trace_prefixF r
                   (observe (peel_ (VisF (evans A0 ev ans) k) (observe t0))) (VisF (evans A0 ev ans) k).
 Proof.
   intros E R S r A0 ev ans k k' t0 f Hk' Ht0 CIH.
-  punfold Ht0. red in Ht0. cbn in *. dependent induction Ht0.
-  - rewrite <- x. unfold observe. cbn. unfold peel_vis.
+  step in Ht0. cbn in *. dependent induction Ht0.
+  - simpobs. unfold observe. cbn. unfold peel_vis.
     assert (A0 = A0); auto. destruct (classicT (A0 = A0)); try contradiction.
     unfold eq_rect_r, eq_rect. remember (eq_sym e) as He.
-    dependent destruction He. cbn. constructor. right. eapply CIH.
+    dependent destruction He. cbn. constructor. eapply CIH. 
     assert (RAnsRef E unit A0 (evans A0 ev ans) tt ev ans); auto with itree.
-    apply Hk' in H0. pclearbot. assert (k1 ans ≈ k' ans); try apply REL.
+    apply Hk' in H0.  assert (k1 ans ≈ k' ans); try apply REL.
     rewrite H1. eauto.
-  - rewrite <- x. cbn. constructor. eapply IHHt0; eauto.
+  - simpobs. cbn. constructor. eapply IHHt0; eauto.
 Qed.
 
 Lemma trace_prefix_vis_evempty: forall (E : Type -> Type) (R S : Type)
@@ -946,10 +902,10 @@ Lemma trace_prefix_vis_evempty: forall (E : Type -> Type) (R S : Type)
                                        (A0 : Type) (Hempty : A0 -> void) (ev : E A0)
                                        (k : void -> itree (EvAns E) R) (A : Type)
                                        (e0 : E A) (t0 : itree E S) (k' : A -> itree E S),
-    eqitF eq true true id
-          (upaco2 (eqit_ eq true true id) bot2)
+    eqitF eq true true 
+          (eutt eq)
           (observe t0) (VisF e0 k') ->
-    trace_prefixF (upaco2 trace_prefix_ r)
+    trace_prefixF r
                   (observe
                      (peel_ (VisF (evempty A0 Hempty ev) k) (TauF t0)))
                   (VisF (evempty A0 Hempty ev) k).
@@ -957,8 +913,8 @@ Proof.
   intros E R S r A0 Hempty ev k A e0 t0 k' Ht0.
   cbn. constructor.
   dependent induction Ht0.
-  - rewrite <- x. cbn. constructor.
-  - rewrite <- x. cbn. constructor. eapply IHHt0; eauto.
+  - simpobs. cbn. constructor.
+  - simpobs. cbn. constructor. eapply IHHt0; eauto.
 Qed.
 
 
@@ -968,18 +924,18 @@ Lemma trace_prefix_peel_ret_vis:  forall (E : Type -> Type) (R S : Type)
                                          (k : unit -> itree (EvAns E) R) (t0 : itree E S)
                                          (s : S),
     t0 ≈ Ret s ->
-    trace_prefixF (upaco2 trace_prefix_ r)
+    trace_prefixF r
                   (observe
                      (peel_ (VisF (evans A0 ev ans) k) (observe t0)))
                   (VisF (evans A0 ev ans) k).
 Proof.
   intros E R S r A0 ev ans k t0 s Ht0.
-  punfold Ht0. red in Ht0. cbn in *. dependent induction Ht0.
-  - rewrite <- x. cbn. remember (go (VisF (evans A0 ev ans) k ) ) as t.
-    enough (trace_prefixF (upaco2 trace_prefix_ r) (RetF s) (observe t) ).
+  step in Ht0. cbn in *. dependent induction Ht0.
+  - simpobs. cbn. remember (go (VisF (evans A0 ev ans) k ) ) as t.
+    enough (trace_prefixF r (RetF s) (observe t) ).
     { subst. auto. }
     constructor.
-  - rewrite <- x. cbn. constructor. eapply IHHt0; eauto.
+  - simpobs. cbn. constructor. eapply IHHt0; eauto.
 Qed.
 
 Lemma trace_prefix_peel_ret_vis_empty: forall (E : Type -> Type) (R S : Type)
@@ -988,18 +944,18 @@ Lemma trace_prefix_peel_ret_vis_empty: forall (E : Type -> Type) (R S : Type)
                                               (k : void -> itree (EvAns E) R) (t0 : itree E S)
                                               (s : S),
     t0 ≈ Ret s ->
-    trace_prefixF (upaco2 trace_prefix_ r)
+    trace_prefixF r
                   (observe
                      (peel_ (VisF (evempty A0 Hempty ev) k) (observe t0)))
                   (VisF (evempty A0 Hempty ev) k).
 Proof.
   intros E R S r A0 Hempty ev k t0 s Ht0.
-  punfold Ht0. red in Ht0. cbn in *. dependent induction Ht0.
-  - rewrite <- x. cbn. remember (go (VisF (evempty A0 Hempty ev) k ) ) as t.
-    enough (trace_prefixF (upaco2 trace_prefix_ r) (RetF s) (observe t) ).
+  step in Ht0. cbn in *. dependent induction Ht0.
+  - simpobs. cbn. remember (go (VisF (evempty A0 Hempty ev) k ) ) as t.
+    enough (trace_prefixF r (RetF s) (observe t) ).
     { subst. auto. }
     constructor.
-  - rewrite <- x. cbn. constructor. eapply IHHt0; eauto.
+  - simpobs. cbn. constructor. eapply IHHt0; eauto.
 Qed.
 
 Lemma trace_prefix_peel : forall (E : Type -> Type) (S R : Type) (b : itrace E R) (t : itree E S)
@@ -1007,36 +963,36 @@ Lemma trace_prefix_peel : forall (E : Type -> Type) (S R : Type) (b : itrace E R
     b ⊑ ITree.bind t f ->
     trace_prefix (peel b t) b.
 Proof.
-  intros E S R. pcofix CIH. intros b t f Href. pfold. red. unfold peel.
-  destruct (observe b) eqn : Heqb; destruct (observe t) eqn : Heqt; cbn.
-  - rewrite <- Heqb. auto with itree.
-  - eapply trace_prefix_tau_ret; eauto.
+  intros E S R. coinduction c CIH. intros b t f Href. unfold peel.
+  destruct (observe b) eqn : Heqb; destruct (observe t) eqn : Heqt; icbn; cbn. 
+  - cbn. auto with itree. 
+  - simpobs. eapply trace_prefix_tau_ret; eauto.
   - symmetry in Heqb. symmetry in Heqt. apply simpobs in Heqb. apply simpobs in Heqt.
     rewrite Heqb in Href. rewrite Heqt in Href. rewrite bind_vis in Href.
-    pinversion Href.
-  - rewrite <- Heqb. auto with itree.
-  - constructor. right. eapply CIH. symmetry in Heqb. symmetry in Heqt.
+    sinv Href.
+  - simpobs. auto with itree.
+  - simpobs. constructor. eapply CIH.  symmetry in Heqb. symmetry in Heqt.
     apply simpobs in Heqb. apply simpobs in Heqt. rewrite Heqb in Href. rewrite Heqt in Href.
     repeat rewrite tau_eutt in Href. eauto.
-  - constructor. rewrite <- Heqt. right. eapply CIH.
+  - simpobs. constructor. rewrite <- Heqt. eapply CIH. 
     symmetry in Heqb. apply simpobs in Heqb. rewrite Heqb in Href.
     rewrite tau_eutt in Href. eauto.
-  - destruct e; cbn; rewrite <- Heqb; auto with itree.
-  - symmetry in Heqb. apply simpobs in Heqb.
+  - simpobs. destruct e; cbn; rewrite <- Heqb; auto with itree.
+  - simpobs. symmetry in Heqb. apply simpobs in Heqb.
     rewrite Heqb in Href.
     apply trace_refine_vis_l in Href as Hbt. destruct Hbt as [A [e0 [k0 Hvis] ]  ].
     symmetry in Heqt. apply simpobs in Heqt. rewrite Heqt in Hvis.
     rewrite tau_eutt in Hvis.
     assert ((exists B, exists k', exists (e1 : E B) , t0 ≈ Vis e1 k') \/ exists s, t0 ≈ Ret s).
     {
-      punfold Hvis. red in Hvis. clear Heqb Heqt.
+      step in Hvis. clear Heqb Heqt.
       dependent induction Hvis.
       - unfold observe in x. cbn in *. destruct (observe t0) eqn : Heqt0; try discriminate.
-        + right. exists r0. pfold. red. cbn. rewrite Heqt0. auto with itree.
+        + right. exists r. step. cbn. rewrite Heqt0. auto with itree.
         + cbn in x. left. exists X0. exists k2. exists e1. symmetry in Heqt0.
           apply simpobs in Heqt0. rewrite Heqt0. reflexivity.
       - unfold observe in x. cbn in *. destruct (observe t0) eqn : Heqt0; try discriminate.
-        + right. exists r0. pfold. red. cbn. rewrite Heqt0. auto with itree.
+        + right. exists r. step. cbn. rewrite Heqt0. auto with itree.
         + injection x as Ht1. symmetry in Heqt0. apply simpobs in Heqt0.
           setoid_rewrite Heqt0. setoid_rewrite tau_eutt. eapply IHHvis; eauto.
           rewrite Ht1. auto.
@@ -1044,31 +1000,32 @@ Proof.
     destruct H as [ [B [k' [e1 Ht0] ] ] | [s Ht0] ].
     + rewrite Heqt in Href. rewrite tau_eutt in Href.
       rewrite Ht0 in Href. rewrite bind_vis in Href.
-      pinversion Href. subst; ddestruction; subst.
-      rewrite Ht0 in Hvis. rewrite bind_vis in Hvis. pinversion Hvis.
+      sinv Href. subst; ddestruction; subst.
+      rewrite Ht0 in Hvis. rewrite bind_vis in Hvis. sinv Hvis.
       subst; ddestruction; subst. clear Heqt Heqb.
-      punfold Ht0. red in Ht0. cbn in *.
+      step in Ht0. cbn in *.
       destruct e.
       * inv H1. ddestruction; subst. cbn. constructor.
         eapply trace_prefix_vis_evans; eauto with itree.
+        now step. 
       * eapply trace_prefix_vis_evempty; eauto.
     + rewrite Heqt in Href. rewrite Ht0 in Href.
       rewrite tau_eutt in Href. rewrite bind_ret_l in Href. clear Hvis.
       destruct e.
       * cbn. constructor. eapply trace_prefix_peel_ret_vis; eauto.
       * cbn. constructor. eapply trace_prefix_peel_ret_vis_empty; eauto.
-  - destruct e; cbn; [ | constructor ].
+  - destruct e; cbn; simpobs; [ | constructor ].
     symmetry in Heqt. apply simpobs in Heqt. rewrite Heqt in Href.
     rewrite bind_vis in Href. symmetry in Heqb. apply simpobs in Heqb.
-    rewrite Heqb in Href. pinversion Href. subst; ddestruction; subst.
+    rewrite Heqb in Href. sinv Href. subst; ddestruction; subst.
     inversion H1. ddestruction; subst.
     unfold observe at 1. cbn. unfold peel_vis. assert (A = A); auto.
     destruct (classicT (A = A) ); try contradiction.
     unfold eq_rect_r, eq_rect. remember (eq_sym e) as He.
-    dependent destruction He. cbn. constructor. right. eapply CIH.
+    dependent destruction He. cbn. constructor. eapply CIH. 
     ddestruction; subst.
     assert (RAnsRef E unit A (evans A ev ans) tt ev ans ); auto with itree.
-    apply H6 in H0. pclearbot. eauto.
+    apply H6 in H0.  eauto.
 Qed.
 
 Lemma peel_bind : forall (E : Type -> Type) (S R : Type) (b : itrace E R) (t : itree E S)
@@ -1092,12 +1049,12 @@ Lemma bind_peel_ret_tau_aux:
     Ret r0 ⊑ ITree.bind t0 f -> exists r : R, t0 ≈ Ret r.
 Proof.
   intros E S R f r0 t0 Hrutt.
-  punfold Hrutt. red in Hrutt. cbn in *. dependent induction Hrutt.
+  step in Hrutt. cbn in *. dependent induction Hrutt.
   - unfold ITree.bind in x. unfold observe in x at 1. cbn in *.
     destruct (observe t0) eqn : Ht0; try discriminate.
-    exists r. pfold. red. rewrite Ht0. constructor. auto.
+    exists r. step. rewrite Ht0. constructor. auto.
   - unfold observe in x. cbn in x. destruct (observe t0) eqn : Ht0; try discriminate.
-    + exists r. pfold. red. rewrite Ht0. constructor. auto.
+    + exists r. step. rewrite Ht0. constructor. auto.
     + symmetry in Ht0. apply simpobs in Ht0. setoid_rewrite Ht0. setoid_rewrite tau_eutt.
       cbn in x. injection x as Ht2. eapply IHHrutt; auto.
       subst. reflexivity.
@@ -1122,9 +1079,9 @@ Proof.
   intros. rewrite bind_trigger in H0. apply trace_refine_vis in H0 as Hvis.
   destruct Hvis as [X [e' [k' Hbvis] ] ]. setoid_rewrite Hbvis.
   rewrite Hbvis in H0.
-  punfold H0. red in H0. cbn in *. inv H0. ddestruction. subst. inv H3; ddestruction; subst.
-  - exists a. exists k'. split; try reflexivity. pclearbot.
+  step in H0. cbn in *. inv H0. ddestruction. subst. inv H3; ddestruction; subst.
+  - exists a. exists k'. split; try reflexivity. 
     assert (RAnsRef E unit A (evans A e a) tt e a ); auto with itree.
-    apply H8 in H0. pclearbot. auto.
+    apply H8 in H0.  auto.
   - destruct H as [a _]. contradiction.
 Qed.
diff --git a/extra/ITrace/ITraceDefinition.v b/extra/ITrace/ITraceDefinition.v
index ed7d7234..81b11a1c 100644
--- a/extra/ITrace/ITraceDefinition.v
+++ b/extra/ITrace/ITraceDefinition.v
@@ -6,8 +6,6 @@ From ITree Require Import
 .
 
 
-From Paco Require Import paco.
-
 Import Monads.
 Import MonadNotation.
 Local Open Scope monad_scope.
diff --git a/extra/ITrace/ITraceFacts.v b/extra/ITrace/ITraceFacts.v
index 828a8281..a9b974ec 100644
--- a/extra/ITrace/ITraceFacts.v
+++ b/extra/ITrace/ITraceFacts.v
@@ -1,5 +1,8 @@
-From Coq Require Import
+From Coinduction Require Import all. 
+
+From Stdlib Require Import
      Morphisms.
+     
 
 From ITree Require Import
      Utils
@@ -7,6 +10,7 @@ From ITree Require Import
      ITree
      ITreeFacts
      Eq.Rutt
+     Eq.RuttFacts
      Props.Infinite.
 
 From ITree.Extra Require Import
@@ -15,12 +19,15 @@ From ITree.Extra Require Import
 
 Set Implicit Arguments.
 
-From Paco Require Import paco.
 
 Import Monads.
 Import MonadNotation.
 Local Open Scope monad_scope.
 
+Tactic Notation "step" := repeat red; step. 
+Tactic Notation "step" "in" ident(h) := repeat red in h; step in h. 
+Tactic Notation "sinv" ident(h) := step in h; inv h. 
+
 Lemma classic_empty : forall (A : Type), ( exists e : A + (A -> void), True ).
 Proof.
   intros. destruct (classic (exists a : A, True)).
@@ -47,24 +54,19 @@ Lemma may_converge_trace : forall (E : Type -> Type) (R : Type)
                              (b : itrace E R) (r1 r2 : R),
     may_converge r1 b -> may_converge r2 b -> r1 = r2.
 Proof.
-  intros. induction H; inversion H0; subst.
-  - rewrite H in H1. pinversion H1. subst. auto.
-  - rewrite H in H1. pinversion H1.
-  - destruct e. destruct b. apply IHmay_converge. rewrite H in H0. inversion H0; subst;
-      contra_void.
-    + pinversion H3.
-    + destruct e; [ | contradiction ]. destruct b.
-      pinversion H3. ddestruction.
-      enough (k tt ≈ k0 tt); try apply REL.
-      rewrite H5. auto.
-    + contradiction.
-  - destruct e. destruct e0. destruct b. destruct b0.
+  intros. induction H; inv H0. 
+  - rewrite H in H1. sinv H1.
+  - rewrite H in H1. sinv H1.
+  - destruct e. destruct b. apply IHmay_converge.
+    + rewrite H in H2. sinv H2. 
+    + contra_void. 
+  - destruct e; try contra_void. 
+    destruct e0; try contra_void.
+    destruct b. destruct b0.
     apply IHmay_converge. rewrite H in H2.
-    pinversion H2. ddestruction.
+    sinv H2. ddestruction.
     subst. enough (k tt ≈ k0 tt); try apply REL.
-    rewrite H4. auto; contra_void.
-    + destruct b0.
-    + destruct b.
+    rewrite H0. auto.
 Qed.
 
 Lemma finite_nil {E : Type -> Type} : finite (@Nil E).
@@ -89,8 +91,9 @@ Proof.
   - destruct IHmay_converge as [l Hl]. unfold ev_list in l.
     inversion e. subst.
     exists (cons e l). simpl. rewrite H.
-    destruct b. pfold. red. cbn. constructor.
-    intros. destruct v. left. auto.
+    destruct b. 
+    apply eqit_Vis. 
+    intros. now destruct u.
     subst. contradiction.
 Qed.
 
@@ -99,15 +102,13 @@ Lemma append_vis : forall (E : Type -> Type) (R : Type)
     Vis e k ++ b ≈ Vis e (fun a => k a ++ b).
 Proof.
   intros E R. unfold append. intros.
-  pfold. red. cbn. constructor. intros. left.
-  enough ( (ITree.bind (k v) (fun _ : unit => b) ≈  (ITree.bind (k v) (fun _ : unit => b) ) ) ); auto.
-  reflexivity.
+  step. cbn. evis. 
 Qed.
 
 Global Instance proper_append {E R} : Proper (@eutt (EvAns E) unit unit eq ==> @eutt (EvAns E) R R eq ==> eutt eq) (@append E R).
 Proof.
   intros log1 log2 Hlog b1 b2 Hb. unfold append. rewrite Hlog.
-  eapply eutt_clo_bind; eauto. reflexivity.
+  eapply eutt_bind_eutt; eauto.
 Qed.
 
 Lemma may_converge_append : forall (E : Type -> Type) (R : Type)
@@ -128,11 +129,11 @@ Lemma converge_itrace_ev_list : forall (E : Type -> Type) (R : Type)
 Proof.
   intros. induction H.
   - exists nil. cbn. rewrite H.
-    pfold. red. cbn. constructor. auto.
+    step. cbn. eret.  
   - destruct IHmay_converge as [log Hlog]. inversion e. subst.
     exists (cons e log). cbn. rewrite append_vis. rewrite H.
-    pfold. red. cbn. constructor. cbn. intros. destruct v.
-    left. destruct b. apply Hlog. subst. contradiction.
+    step. constructor. intros. destruct v.  
+    destruct b. apply Hlog. subst. contradiction.
 Qed.
 
 Lemma classic_converge_itrace : forall (E : Type -> Type) (R : Type) (b : itrace E R),
@@ -169,7 +170,7 @@ Proof.
   intros. induction log.
   - cbn. unfold append. rewrite bind_ret_l. auto.
   - cbn. unfold append.
-    pfold. red. cbn. constructor. intros. left. auto.
+    step. repeat red. cbn. constructor. intro. auto. 
 Qed.
 
 Lemma inv_append_eutt : forall (E : Type -> Type) (R : Type) (r1 r2 : R)
@@ -179,15 +180,13 @@ Lemma inv_append_eutt : forall (E : Type -> Type) (R : Type) (r1 r2 : R)
 Proof.
   intros. generalize dependent log2. induction log1; intros.
   - destruct log2.
-    + split; auto. cbn in H. pinversion H. cbn. unfold append in *.
-      cbn in *. subst. auto.
-    + pinversion H.
+    + split; auto. cbn in H. sinv H. 
+    + sinv H.
   - destruct log2.
-    + pinversion H.
-    + cbn in H. unfold append in H. pinversion H. cbn in *. ddestruction.
-      subst.
+    + sinv H.
+    + cbn in H. unfold append in H. sinv H. cbn in *. ddestruction.
       enough (log1 = log2 /\ r1 = r2).
-      { destruct H0. subst. auto. }
+      { destruct H. subst. auto. }
       apply IHlog1. apply REL. apply tt.
 Qed.
 
@@ -195,111 +194,110 @@ Lemma trace_refine_proper_left' : forall (E : Type -> Type) (R : Type) (b1 b2 :
                                     (t : itree E R), (b1 ≈ b2) -> rutt (REvRef E) (RAnsRef E) eq b1 t ->
                                                      rutt (REvRef E) (RAnsRef E) eq b2 t.
 Proof.
-  intros E R. pcofix CIH. intros. pfold. red.
-  punfold H1. red in H1.  punfold H0. red in H0.
-  genobs_clear t ot3.
-  hinduction H0 before CIH; intros; clear b1 b2; eauto.
-  - remember (RetF r1) as ot1. hinduction H1 before CIH; intros; inv Heqot1; eauto with paco.
+  intros E R. icoinduction c CIH. intros. 
+  step in H0. repeat red in H0. step in H.
+  genobs t ot3. clear Heqot3. 
+  hinduction H before CIH; intros; subst; eauto.
+  - remember (RetF r2) as ot1. hinduction H0 before CIH; intros; inv Heqot1; eauto.  
     + constructor. auto.
     + constructor. eapply IHruttF; eauto.
   (* Tau Tau case causes the most problems, seems *)
   -  assert (DEC: (exists m3, ot3 = TauF m3) \/ (forall m3, ot3 <> TauF m3)).
      { destruct ot3; eauto; right; red; intros; inv H. }
      destruct DEC as [EQ | EQ].
-     + destruct EQ as [m3 ?]; subst. pclearbot.
-       constructor. right. eapply CIH; eauto.
-       apply rutt_inv_Tau. pfold. auto.
-     + inv H1; try (exfalso; eapply EQ; eauto; fail).
-       pclearbot. constructor.
-       punfold REL. red in REL.
-       hinduction H0 before CIH; intros; subst; try (exfalso; eapply EQ; eauto; fail).
+     + destruct EQ as [m3 ?]; subst.
+       constructor. eapply CIH; eauto.
+       apply rutt_inv_Tau. now step. 
+     + inv H0; try (exfalso; eapply EQ; eauto; fail).
+       constructor.
+       step in REL. 
+       hinduction H1 before CIH; intros; subst; try (exfalso; eapply EQ; eauto; fail).
        * dependent induction REL; rewrite <- x.
          ++ constructor. auto.
          ++ constructor. eapply IHREL; eauto.
        * dependent induction REL; rewrite <- x.
-         ++ constructor; auto. intros. apply H0 in H1. right.
-            pclearbot. eapply CIH; eauto with itree.
+         ++ constructor; auto. intros. apply H0 in H1. 
+            eapply CIH. apply REL. assumption. 
          ++ constructor. eapply IHREL; eauto.
        * eapply IHruttF; eauto. clear IHruttF.
          dependent induction REL; try (exfalso; eapply EQ; eauto; fail).
-         ++ pclearbot. rewrite <- x. constructor; auto. pstep_reverse.
+         ++ rewrite <- x. constructor; auto. now unstep. 
          ++ auto.
          ++ rewrite <- x. constructor; auto. eapply IHREL; eauto.
   - remember (VisF e k1) as ot1.
-    hinduction H1 before CIH; intros; dependent destruction Heqot1.
-    + pclearbot. constructor; auto. intros. apply H0 in H1.
-      pclearbot. right.
-      eapply CIH; eauto with itree.
+    hinduction H0 before CIH; intros; dependent destruction Heqot1.
+    + constructor; auto. intros. apply H0 in H1.
+      eapply CIH. apply REL. assumption. 
     + constructor. eapply IHruttF; eauto.
-  - eapply IHeqitF. remember (TauF t1) as otf1.
-    hinduction H1 before CIH; intros;  dependent destruction Heqotf1; eauto.
-    + constructor. pclearbot. pstep_reverse.
+  - eapply IHeqitF; eauto. remember (TauF t1) as otf1.
+    hinduction H0 before CIH; intros; dependent destruction Heqotf1; eauto.
+    + constructor. now unstep. 
     + constructor. eapply IHruttF; eauto.
-  - constructor. eapply IHeqitF. eauto.
+  - constructor. eapply IHeqitF; eauto.
 Qed.
 
 Lemma trace_refine_proper_right' : forall (E : Type -> Type) (R : Type) (b : itrace E R)
                                      (t1 t2 : itree E R), t1 ≈ t2 -> rutt (REvRef E) (RAnsRef E) eq b t1 ->
                                                           rutt (REvRef E) (RAnsRef E) eq b t2.
 Proof.
-  intros E R. pcofix CIH. intros. punfold H1. red in H1.
-  punfold H0. red in H0. pfold. red.
+  intros E R. icoinduction c CIH. intros. step in H. 
+  step in H0. repeat red in H0. 
   genobs_clear t2 ot2.
-  hinduction H0 before CIH; intros; clear t1; subst; eauto.
-  - remember (RetF r2) as ot1. hinduction H1 before CIH; intros; inv Heqot1; eauto with paco.
+  hinduction H before CIH; intros; clear t1; subst; eauto.
+  - remember (RetF r2) as ot1. hinduction H0 before CIH; intros; inv Heqot1; eauto.
     + constructor; auto.
     + constructor. eauto.
-  - pclearbot. remember (TauF m1) as otm1.
-    hinduction H1 before CIH; intros; subst; try (inv Heqotm1).
-    + constructor. pclearbot. right. eapply CIH; eauto.
-    + constructor. right. eapply CIH; eauto.
-      apply rutt_inv_Tau_r. pfold. auto.
-    + punfold REL. red in REL.
+  - remember (TauF m1) as otm1.
+    hinduction H0 before CIH; intros; subst; try (inv Heqotm1).
+    + constructor. eapply CIH; eauto.
+    + constructor. eapply CIH; eauto.
+      apply rutt_inv_Tau_r. now step. 
+    + step in REL. 
       dependent induction REL; subst.
       * constructor. clear IHruttF.
-        hinduction H1 before CIH; intros; dependent destruction x0.
+        hinduction H0 before CIH; intros; dependent destruction x0.
         ++ rewrite <- x. constructor. auto.
         ++ constructor. auto.
-      * pclearbot. eapply IHruttF; auto. 2 : symmetry; eauto.
-        pclearbot. pfold. red. rewrite <- x. constructor; auto.
-        punfold REL.
+      * eapply IHruttF. 2 : symmetry; eauto.
+        step. rewrite <- x. constructor; auto.
+        now step in REL. 
       * constructor. rewrite <- x.
-        clear IHruttF. hinduction H1 before CIH; intros; dependent destruction x0.
+        clear IHruttF. hinduction H0 before CIH; intros; dependent destruction x0.
         ++ constructor; auto. intros. apply H0 in H1.
-           pclearbot. right. eapply CIH; eauto with itree.
+          eapply CIH. apply REL. assumption. 
         ++ constructor. eapply IHruttF; eauto.
-      * eapply IHruttF; eauto.
+      * unstep in REL. eapply IHruttF; eauto.
       * constructor. rewrite <- x. eapply IHREL; eauto.
-  - remember (VisF e k1) as ot1. hinduction H1 before CIH; intros; inv Heqot1.
+  - remember (VisF e k1) as ot1. hinduction H0 before CIH; intros; inv Heqot1.
     + ddestruction. constructor; auto. intros. apply H0 in H1.
-      right. pclearbot. eapply CIH; eauto; apply REL.
+      eapply CIH. apply REL. assumption. 
     + constructor. eauto.
   - eapply IHeqitF; eauto. remember (TauF t0) as otf0.
-    hinduction H1 before CIH; intros; dependent destruction Heqotf0; eauto.
-    + constructor. pclearbot. pstep_reverse.
+    hinduction H0 before CIH; intros; dependent destruction Heqotf0; eauto.
+    + constructor. now unstep. 
     + constructor. eapply IHruttF; eauto.
-  - constructor. eapply IHeqitF. eauto.
+  - constructor. eapply IHeqitF; eauto.
 Qed.
 
 #[global] Instance trace_refine_proper {E R} : Proper (@eutt E R R eq ==> eutt eq ==> iff) trace_refine.
 Proof.
   intros b1 b2 Heuttb t1 t2 Heuttt.
   split; intros;
-    try (eapply trace_refine_proper_right'; [eauto | eapply trace_refine_proper_left'; eauto]);
-    auto; symmetry; auto.
+    try (eapply trace_refine_proper_right'; [eauto | eapply trace_refine_proper_left'; eauto]).
+    now rewrite Heuttb, Heuttt.
 Qed.
 
 Lemma trace_refine_ret : forall (E : Type -> Type) (R : Type) (r : R),
     @trace_refine E R (Ret r) (Ret r).
 Proof.
-  intros. pfold. constructor. auto.
+  intros. step. constructor. auto.
 Qed.
 
 Lemma trace_refine_ret_inv_r : forall (E : Type -> Type) (R : Type) (r : R)
                                  (t : itree E R),
     Ret r ⊑ t -> t ≈ Ret r.
 Proof.
-  intros. pfold. red. punfold H. red in H. cbn in *.
+  intros. step. step in H. repeat red in H. 
   dependent induction H; subst.
   - rewrite <- x. constructor. auto.
   - rewrite <- x. constructor; auto.
@@ -309,7 +307,7 @@ Lemma trace_refine_ret_inv_l : forall (E : Type -> Type) (R : Type) (r : R)
                                  (b : itrace E R),
     b ⊑ Ret r -> (b ≈ Ret r)%itree.
 Proof.
-  intros. pfold. red. punfold H. red in H. cbn in *.
+  intros. step. step in H. repeat red in H.
   dependent induction H; subst.
   - rewrite <- x. constructor. auto.
   - rewrite <- x. constructor; auto.
@@ -320,18 +318,17 @@ Lemma trace_refine_vis_inv : forall (E : Type -> Type) (R A: Type) (e : E A) (a
     trace_refine (Vis e k) (Vis (evans A e a) (fun _ => b))  -> trace_refine (k a) b .
 Proof.
   intros E R A e a. intros.
-  red in H. red. punfold H. red in H. inversion H. ddestruction.
+  red in H. red. step in H. repeat red in H. inv H. ddestruction.
   subst.
   assert (RAnsRef E unit A (evans A e a) tt e a); eauto with itree.
-  apply H7 in H0. pclearbot. auto.
 Qed.
 
 Lemma trace_refine_vis_add : forall (E : Type -> Type) (R A: Type) (e : E A) (a : A)
                                (b :itrace E R) (k : A -> itree E R),
     b ⊑ k a -> Vis (evans A e a) (fun _ => b) ⊑ Vis e k.
 Proof.
-  intros. pfold. red. cbn. constructor; eauto with itree.
-  intros. left. inversion H0. ddestruction.
+  intros. step. constructor; eauto with itree.
+  intros. inv H0. ddestruction.
   subst. auto.
 Qed.
 
@@ -370,11 +367,12 @@ Lemma itree_refine_nonempty : forall (E : Type -> Type) (R : Type) (t : itree E
 Proof.
   intros. destruct classicT_inhabited as [classicT].
   exists (determinize classicT t). generalize dependent t.
-  pcofix CIH. intros. pfold. red. unfold determinize. destruct (observe t).
-  - cbn. constructor. auto.
-  - cbn. constructor. right. apply CIH.
+  icoinduction c CIH. 
+  intros. unfold determinize. desobs t Hot.
+  - cbn. eret.
+  - cbn. constructor. apply CIH. 
   - unfold observe. cbn. destruct (classicT _).
-    + constructor; eauto with itree. intros. right.
+    + constructor; eauto with itree. intros.
       inversion H. ddestruction.
       subst. apply CIH.
     + constructor; auto with itree. intros. contradiction.
@@ -387,7 +385,7 @@ Lemma refine_set_eq_to_eutt_vis_aux : forall (E : Type -> Type) (R : Type) (r :
                                              (A B : Type) (e : E A) (e0 : E B)
                                              (k : A -> itree E R) (k0 : B -> itree E R)
                                              (Ht1 : t1 ≅ Vis e k) (Ht2 : t2 ≅ Vis e0 k0 ),
-    eqitF eq true true id (upaco2 (eqit_ eq true true id) r) (VisF e k) (VisF e0 k0).
+    eqitF eq true true r (VisF e k) (VisF e0 k0).
 Proof.
   intros.
   destruct (classic_empty A) as [ [a | Ha] _ ].
@@ -398,12 +396,12 @@ Proof.
     rewrite <- Ht1 in Hbk.
     apply H0 in Hbk as Hbk0.
     rewrite Ht1 in Hbk. rewrite Ht2 in Hbk0.
-    pinversion Hbk.
-    pinversion Hbk0. ddestruction.
+    sinv Hbk.
+    sinv Hbk0. ddestruction.
     subst.
-    inversion H10. ddestruction.
+    inversion H8. ddestruction.
     subst. constructor.
-    intros. right. eapply CIH; eauto.
+    intros. eapply CIH; eauto.
     intros. setoid_rewrite Ht1 in H0. setoid_rewrite Ht2 in H0.
     split; intros.
     + apply trace_refine_vis_add with (e := e) in H. apply H0 in H.
@@ -414,15 +412,15 @@ Proof.
     set (Vis (evempty A Ha e) ke) as b.
     assert (b ⊑ t1).
     {
-      unfold b. rewrite Ht1. pfold. red. cbn.
+      unfold b. rewrite Ht1. step. cbn.
       constructor. { apply ree. } { intros []. }
     }
     apply H0 in H as H1. unfold b in *. clear b.
     rewrite Ht1 in H. rewrite Ht2 in H1.
-    pinversion H. pinversion H1. ddestruction.
-    subst. inversion H12. ddestruction.
+    sinv H. sinv H1. ddestruction.
+    subst. inversion H6. ddestruction.
     constructor.
-    intros. right. eapply CIH.
+    intros. eapply CIH.
     intros. setoid_rewrite Ht1 in H0. setoid_rewrite Ht2 in H0.
     split; intros; contradiction.
 Qed.
@@ -431,7 +429,7 @@ Lemma trace_refine_vis : forall (E : Type -> Type) (R A : Type) (b : itrace E R)
                            (e : E A) (k : A -> itree E R),
     b ⊑ Vis e k -> exists X, exists e0 : EvAns E X, exists k0, (b ≈ Vis e0 k0)%itree.
 Proof.
-  intros. punfold H. red in H. cbn in H.
+  intros. step in H. repeat red in H. 
   dependent induction H.
   - exists A0. exists e1. exists k1.
     specialize (itree_eta b) as Hb. rewrite <- x in Hb.
@@ -451,7 +449,7 @@ Lemma trace_refine_vis_l : forall (E : Type -> Type) (R A: Type) (t : itree E R)
                                   (e : EvAns E A) (k : A -> itrace E R),
     Vis e k ⊑ t -> exists X, exists e0 : E X, exists k0 : X -> itree E R, t ≈ Vis e0 k0.
 Proof.
-  intros. punfold H. red in H. cbn in *.
+  intros. step in H. repeat red in H. 
   dependent induction H.
   - exists B. exists e2.  exists k2. specialize (itree_eta t) as Ht.
     rewrite <- x in Ht. rewrite Ht. reflexivity.
@@ -486,33 +484,35 @@ Proof.
     rewrite H0. constructor. reflexivity.
   - rewrite H in H1. apply trace_refine_vis_l in H1 as Ht0.
     destruct Ht0 as [X [e0 [k0 Ht0] ] ].
-    rewrite Ht0 in H1. pinversion H1. subst.
+    rewrite Ht0 in H1. sinv H1. subst.
     ddestruction. subst. rewrite Ht0.
     inversion H4; subst; ddestruction; subst; try contradiction.
     eapply conv_vis; try reflexivity. Unshelve. 2 : exact a.
-    apply IHmay_converge. pclearbot.
+    apply IHmay_converge. 
     specialize (H9 tt a). assert (RAnsRef E unit X (evans X e0 a) tt e0 a).
-    constructor. apply H9 in H2. pclearbot. destruct b. auto.
+    constructor. apply H9 in H1. destruct b. auto.
 Qed.
 
 Lemma trace_refine_all_infinite : forall (E : Type -> Type) (R : Type)
                                     (t : itree E R) (b : itrace E R),
     all_infinite t -> b ⊑ t -> all_infinite b.
 Proof.
-  intros E R. pcofix CIH. intros. punfold H0. red in H0.
-  punfold H1. red in H1. pfold. red. dependent induction H1.
-  - rewrite <- x in H0. inversion H0.
-  - rewrite <- x0. constructor. right. pclearbot. eapply CIH; eauto.
-    rewrite <- x in H0. inv H0. pclearbot. auto.
-  - rewrite <- x0. rewrite <- x in H0. constructor. inv H0.
-    ddestruction. subst. intros. right. pclearbot.
-    inversion H; subst; ddestruction; try contradiction. destruct b0.
+  intros E R. unfold all_infinite at -1. 
+  coinduction c CIH. 
+  intros. step in H. step in H0. repeat red in H, H0; repeat red.   
+  dependent induction H0.
+  - rewrite <- x in H. inv H. 
+  - rewrite <- x0. constructor. eapply CIH; eauto.
+    rewrite <- x in H. inv H.
+  - rewrite <- x0. rewrite <- x in H. constructor. inv H.
+    ddestruction. subst. intros. 
+    inv H1; subst; ddestruction; try contradiction. destruct b0.
     eapply CIH; try apply H3.
-    specialize (H1 tt a). assert (RAnsRef _ _ _ (evans B e2 a) tt e2 a ).
-    constructor. apply H1 in H0. pclearbot. eauto.
-  - rewrite <- x. constructor. left.  pfold. eapply IHruttF; eauto.
-  - eapply IHruttF; auto. rewrite <- x in H0. inv H0.
-    pclearbot. punfold H2.
+    specialize (H0 tt a). assert (RAnsRef _ _ _ (evans B e2 a) tt e2 a ).
+    constructor. apply H0 in H. eauto.
+  - rewrite <- x. constructor. apply (b_chain c). eapply IHruttF; eauto.
+  - eapply IHruttF; auto. rewrite <- x in H. inv H.
+    now step in H2. 
 Qed.
 
 Lemma trace_refine_converge_bind : forall (E : Type -> Type) (R S : Type)
@@ -525,12 +525,12 @@ Proof.
   - specialize (IHmay_converge H1).
     rewrite H in H2. apply trace_refine_vis_l in H2 as Ht.
     destruct Ht as [X [e0 [k0 Ht] ] ].
-    rewrite Ht in H2. punfold H2. red in H2. cbn in H2. inversion H2; subst.
-    ddestruction. subst. pclearbot.
-    inversion H5; ddestruction; subst; try contradiction.
-    ddestruction. subst. rewrite H. rewrite Ht.
-    pfold. red. cbn. constructor; auto.
-    intros. apply H10 in H3. pclearbot. left.
+    rewrite Ht in H2. step in H2. repeat red in H2. inv H2. 
+    ddestruction. subst.
+    inversion H5; subst; ddestruction; try easy. 
+    rewrite H. rewrite Ht.
+    step. repeat red. cbn. constructor; auto.
+    intros. apply H10 in H2.
     destruct a0. destruct b. apply IHmay_converge. auto.
 Qed.
 
@@ -539,20 +539,20 @@ Lemma trace_refine_diverge_bind : forall (E : Type -> Type) (R S : Type)
     all_infinite b -> b ⊑ t -> ITree.bind b f ⊑ ITree.bind t g.
 Proof.
   intros E R S b t f g. generalize dependent b. generalize dependent t.
-  pcofix CIH. intros.
-  punfold H0. red in H0.
-  punfold H1. red in H1. pfold. red. cbn.
-  dependent induction H1.
-  - rewrite <- x0 in H0. inv H0.
+  red. icoinduction c CIH. intros.
+  step in H0. 
+  step in H. repeat red in H0, H. 
+  dependent induction H0.
+  - rewrite <- x0 in H. inv H.
   - unfold observe. cbn. rewrite <- x0. rewrite <- x.
-    cbn. constructor. right. pclearbot. apply CIH; auto.
-    rewrite <- x0 in H0. inv H0. pclearbot. auto.
+    cbn. constructor. apply CIH; auto.
+    rewrite <- x0 in H. inv H. 
   - unfold observe. cbn. rewrite <- x0. rewrite <- x. cbn. constructor; auto.
     intros.
-    rewrite <- x0 in H0. inv H0. ddestruction. subst. pclearbot.
-    apply H1 in H2. right. pclearbot. eapply CIH; eauto. apply H4.
+    rewrite <- x0 in H. inv H. ddestruction. subst. 
+    apply H0 in H2. eapply CIH; eauto. apply H4.
   - unfold observe at 1. cbn. rewrite <- x. cbn. constructor.
-    eapply IHruttF; eauto. rewrite <- x in H0. inv H0. pclearbot. pstep_reverse.
+    eapply IHruttF; eauto. rewrite <- x in H. inv H. now unstep.
   - unfold observe at 2. cbn. rewrite <- x. cbn. constructor.
     eapply IHruttF; eauto.
 Qed.
@@ -560,61 +560,50 @@ Qed.
 Lemma refine_set_eq_to_eutt : forall (E : Type -> Type) (R : Type) (t1 t2 : itree E R),
     (forall b, b ⊑ t1 <-> b ⊑ t2) -> t1 ≈ t2.
 Proof.
-  intros E R. pcofix CIH. intros.
-  pfold. red.
+  intros E R. icoinduction c CIH. intros.
   remember (observe t1) as ot1. remember (observe t2) as ot2.
   destruct (ot1); destruct (ot2).
+  all: specialize (itree_eta t1) as Ht1; rewrite <- Heqot1 in Ht1;
+    specialize (itree_eta t2) as Ht2; rewrite <- Heqot2 in Ht2.
   (*Ret Ret*)
-  - specialize (H0 (Ret r0) ) as Hr0.
-    specialize (itree_eta t1) as Ht1. rewrite <- Heqot1 in Ht1.
-    specialize (itree_eta t2) as Ht2. rewrite <- Heqot2 in Ht2.
-    rewrite Ht1 in Hr0. rewrite Ht2 in Hr0.
-    assert (Ret r0 ⊑ t2).
-    { rewrite Ht2. apply Hr0. pfold. constructor. auto. }
-    rewrite Ht2 in H. pinversion H. subst. constructor. auto.
-  (*Ret Tau *)
-  - specialize (itree_eta t1) as Ht1. rewrite <- Heqot1 in Ht1.
-    specialize (itree_eta t2) as Ht2. rewrite <- Heqot2 in Ht2.
-    setoid_rewrite Ht2 in H0.
-    specialize (H0 (Ret r0) ).
-    rewrite tau_eutt in H0. constructor; auto.
+  - specialize (H (Ret r0)) as Hr0.
+    rewrite Ht1 in Hr0. rewrite Ht2 in Hr0. 
     assert (Ret r0 ⊑ t1).
-    { rewrite Ht1. pfold. constructor. auto. }
-    apply H0 in H. punfold H. red in H. cbn in H.
-    clear H0 Ht1 Ht2 Heqot1 Heqot2. dependent induction H.
-    + rewrite <- x. constructor; auto.
-    + rewrite <- x. constructor; auto.
+    { rewrite Ht1. apply Hr0. step. eret. }
+    rewrite Ht1 in H0. sinv H0. 
+  (*Ret Tau *)
+  - setoid_rewrite Ht2 in H.
+    specialize (H (Ret r) ).
+    rewrite tau_eutt in H. taur. 
+    assert (Ret r ⊑ t1).
+    { rewrite Ht1. step. eret. }
+    apply H in H0. step in H0. repeat red in H0; cbn in H0.
+    clear H Ht1 Ht2 Heqot1 Heqot2. dependent induction H0.
+    + rewrite <- x. eret. 
+    + rewrite <- x. taur; auto.   
   (*Ret Vis*)
   - exfalso.
-    specialize (itree_eta t1) as Ht1. rewrite <- Heqot1 in Ht1.
-    specialize (itree_eta t2) as Ht2. rewrite <- Heqot2 in Ht2.
-    assert (Ret r0 ⊑ t1).
-    { rewrite Ht1. pfold. constructor. auto. }
-    apply H0 in H. rewrite Ht2 in H. pinversion H.
+    assert (Ret r ⊑ t1).
+    { rewrite Ht1. step. eret. }
+    apply H in H0. rewrite Ht2 in H0. sinv H0. 
   (*Tau Ret*)
-  - specialize (itree_eta t1) as Ht1. rewrite <- Heqot1 in Ht1.
-    specialize (itree_eta t2) as Ht2. rewrite <- Heqot2 in Ht2.
-    setoid_rewrite Ht1 in H0. setoid_rewrite Ht2 in H0.
-    assert (Ret r0 ⊑ t2).
-    { rewrite Ht2. pfold. constructor. auto. }
-    rewrite Ht2 in H. apply H0 in H as H1. punfold H1.
-    clear Heqot1 Heqot2 Ht1 Ht2 H H0. red in H1. cbn in *.
-    constructor; auto. inv H1. dependent induction H2; intros; subst.
-    + rewrite <- x. constructor; auto.
-    + rewrite <- x. auto with itree.
+  - setoid_rewrite Ht1 in H. setoid_rewrite Ht2 in H.
+    assert (Ret r ⊑ t2).
+    { rewrite Ht2. step. eret. }
+    rewrite Ht2 in H0. apply H in H0 as H1. step in H1. 
+    clear Heqot1 Heqot2 Ht1 Ht2 H H0. repeat red in H1. cbn in *.
+    taul. inv H1. dependent induction H2; intros; subst.
+    + rewrite <- x. eret. 
+    + rewrite <- x. taul; auto. 
   (*Tau Tau*)
-  - constructor. right. eapply CIH.
+  - constructor. eapply CIH. 
     intros.
-    specialize (itree_eta t1) as Ht1. rewrite <- Heqot1 in Ht1.
-    specialize (itree_eta t2) as Ht2. rewrite <- Heqot2 in Ht2.
     assert (t1 ≈ t). { rewrite Ht1. rewrite tau_eutt. reflexivity. }
     assert (t2 ≈ t0). { rewrite Ht2. rewrite tau_eutt. reflexivity. }
-    rewrite <- H. rewrite <- H1. auto.
+    now rewrite <- H0, <- H1. 
   (*Tau Vis*)
-  - specialize (itree_eta t1) as Ht1. rewrite <- Heqot1 in Ht1.
-    specialize (itree_eta t2) as Ht2. rewrite <- Heqot2 in Ht2.
-    specialize (itree_refine_nonempty t1) as [b Hbt1].
-    apply H0 in Hbt1 as Hbt2. rewrite Ht1 in Hbt1.
+  - specialize (itree_refine_nonempty t1) as [b Hbt1].
+    apply H in Hbt1 as Hbt2. rewrite Ht1 in Hbt1.
     rewrite tau_eutt in Hbt1.
     rewrite Ht2 in Hbt2.
     apply trace_refine_vis in Hbt2 as Hb.
@@ -622,9 +611,9 @@ Proof.
     rewrite Hb in Hbt2.
     rewrite Hb in Hbt1. clear Hb b.
     constructor; auto.
-    setoid_rewrite Ht1 in H0. setoid_rewrite tau_eutt in H0.
+    setoid_rewrite Ht1 in H. setoid_rewrite tau_eutt in H.
     clear Heqot1 Heqot2. clear Ht1 t1.
-    punfold Hbt1. red in Hbt1. cbn in *.
+    step in Hbt1. repeat red in Hbt1. cbn in *.
     dependent induction Hbt1.
     + rewrite <- x.
       specialize (itree_eta t) as Ht. rewrite <- x in Ht.
@@ -635,19 +624,15 @@ Proof.
         specialize (itree_eta t) as Ht. rewrite <- x in Ht. rewrite Ht.
         rewrite tau_eutt. reflexivity.
       }
-      setoid_rewrite H. auto.
+      setoid_rewrite H0. auto.
   (*Vis Ret*)
   - exfalso.
-    specialize (itree_eta t1) as Ht1. rewrite <- Heqot1 in Ht1.
-    specialize (itree_eta t2) as Ht2. rewrite <- Heqot2 in Ht2.
-    assert (Ret r0 ⊑ t2).
-    { rewrite Ht2. pfold. constructor. auto. }
-    apply H0 in H. rewrite Ht1 in H. pinversion H.
+    assert (Ret r ⊑ t2).
+    { rewrite Ht2. step. eret. }
+    apply H in H0. rewrite Ht1 in H0. sinv H0.
   (*Vis Tau*)
-  - specialize (itree_eta t1) as Ht1. rewrite <- Heqot1 in Ht1.
-    specialize (itree_eta t2) as Ht2. rewrite <- Heqot2 in Ht2.
-    specialize (itree_refine_nonempty t2) as [b Hbt2].
-    apply H0 in Hbt2 as Hbt1. rewrite Ht1 in Hbt1.
+  - specialize (itree_refine_nonempty t2) as [b Hbt2].
+    apply H in Hbt2 as Hbt1. rewrite Ht1 in Hbt1.
     rewrite Ht2 in Hbt2.
     rewrite tau_eutt in Hbt2.
     apply trace_refine_vis in Hbt1 as Hb.
@@ -655,9 +640,9 @@ Proof.
     rewrite Hb in Hbt2.
     rewrite Hb in Hbt1. clear Hb b.
     constructor; auto.
-    setoid_rewrite Ht2 in H0. setoid_rewrite tau_eutt in H0.
+    setoid_rewrite Ht2 in H. setoid_rewrite tau_eutt in H.
     clear Heqot1 Heqot2. clear Ht2 t2.
-    punfold Hbt2. red in Hbt2. cbn in *.
+    step in Hbt2. repeat red in Hbt2. cbn in *.
     dependent induction Hbt2.
     + rewrite <- x.
       specialize (itree_eta t) as Ht. rewrite <- x in Ht.
@@ -668,11 +653,9 @@ Proof.
         specialize (itree_eta t) as Ht. rewrite <- x in Ht. rewrite Ht.
         rewrite tau_eutt. reflexivity.
       }
-      setoid_rewrite H. auto.
+      setoid_rewrite H0. auto.
   (*Vis Vis*)
-  - specialize (itree_eta t1) as Ht1. rewrite <- Heqot1 in Ht1.
-    specialize (itree_eta t2) as Ht2. rewrite <- Heqot2 in Ht2.
-    eapply refine_set_eq_to_eutt_vis_aux; eauto.
+    - eapply refine_set_eq_to_eutt_vis_aux; eauto.
 Qed.
 
 Lemma trace_set_complete : forall E R (t1 t2 : itree E R), (forall b, b ⊑ t1 <-> b ⊑ t2) <-> t1 ≈ t2.
@@ -686,26 +669,26 @@ Lemma trace_refine_bind_cont_inv : forall (E : Type -> Type) (R S : Type)
                                           (f : R -> itree E S) (r : R),
     may_converge r b -> b ⊑ m -> ITree.bind b g ⊑ ITree.bind m f -> g r ⊑ f r.
 Proof.
-  intros E R S. pcofix CIH. intros b m g f a Hconv Hrefb Hrefbind.
+  intros E R S. red. coinduction c CIH. intros b m g f a Hconv Hrefb Hrefbind.
   generalize  dependent m.
   dependent induction  Hconv; intros m Hrefb Hrefbind.
   - rewrite H in Hrefbind. rewrite bind_ret_l in Hrefbind. rewrite H in Hrefb.
     apply trace_refine_ret_inv_r in Hrefb. rewrite Hrefb in Hrefbind.
-    rewrite bind_ret_l in Hrefbind. apply pacobot2; eauto.
+    rewrite bind_ret_l in Hrefbind. now step. 
   - (*m must be a vis, the continuations must refine then continuation in the m I use in the
       inductive hypothesis *)
     destruct e; try contradiction. rewrite H in Hrefb.
     rewrite H in Hrefbind. rewrite bind_vis in Hrefbind.
     apply trace_refine_vis_l in Hrefb as Hvis. destruct Hvis as [X [e' [k' Hvis ] ] ].
     rewrite Hvis in Hrefbind. rewrite bind_vis in Hrefbind.
-    punfold Hrefbind. red in Hrefbind. cbn in Hrefbind. inv Hrefbind.
+    step in Hrefbind. repeat red in Hrefbind; cbn in Hrefbind. inv Hrefbind.
     ddestruction. inv H2. ddestruction; subst.
-    rewrite Hvis in Hrefb. punfold Hrefb. red in Hrefb. cbn in Hrefb. inv Hrefb.
+    rewrite Hvis in Hrefb. step in Hrefb. repeat red in Hrefb; cbn in Hrefb. inv Hrefb.
     ddestruction.
     assert (RAnsRef E unit A (evans _ e' ans) tt e' ans ); try (constructor; auto; fail).
     specialize (IHHconv (k' ans) ). apply IHHconv.
-    + apply H8 in H0. pclearbot. destruct b. auto.
-    + apply H7 in H0. pclearbot. destruct b. auto.
+    + apply H8 in H0. destruct b. auto.
+    + apply H7 in H0. destruct b. auto.
 Qed.
 
 Lemma may_converge_two_list:
@@ -721,8 +704,8 @@ Proof.
     { cbn. reflexivity. }
     rewrite H0 in H.
     destruct log' as [ | h t ].
-    + setoid_rewrite bind_ret_l in H. simpl in H. pinversion H.
-    + simpl in H. unfold append in H. repeat rewrite bind_vis in H. pinversion H.
+    + setoid_rewrite bind_ret_l in H. simpl in H. sinv H. 
+    + simpl in H. unfold append in H. repeat rewrite bind_vis in H. sinv H.
       ddestruction; subst.
       assert (ev_list_to_stream log ++ b ≈ ev_list_to_stream t ++ Ret a).
       { apply REL. apply tt. }
@@ -736,6 +719,6 @@ Proof.
   intros E A log b' Hdiv. induction log.
   - cbn in Hdiv. setoid_rewrite bind_ret_l in Hdiv. auto.
   - apply IHlog. simpl in Hdiv. unfold append in Hdiv.
-    rewrite bind_vis in Hdiv. pinversion Hdiv. ddestruction. subst. apply H0.
+    rewrite bind_vis in Hdiv. sinv Hdiv. ddestruction. subst. apply H0.
     apply tt.
 Qed.
diff --git a/extra/ITrace/ITracePreds.v b/extra/ITrace/ITracePreds.v
index daf10d56..36d2c257 100644
--- a/extra/ITrace/ITracePreds.v
+++ b/extra/ITrace/ITracePreds.v
@@ -1,4 +1,5 @@
-From Coq Require Import
+From Coinduction Require Import all. 
+From Stdlib Require Import
      Morphisms
 .
 
@@ -13,8 +14,6 @@ From ITree.Extra Require Import
      ITrace.ITraceBind
 .
 
-From Paco Require Import paco.
-
 Import Monads.
 Import MonadNotation.
 Local Open Scope monad_scope.
@@ -34,28 +33,29 @@ Variant trace_forallF {E : Type -> Type} {R : Type} (F : itrace E R -> Prop)
 Definition trace_forall_ {E R} PE PR F (b : itrace E R) :=
   trace_forallF F PE PR (observe b).
 
-Lemma trace_forall_monot {E R} PE PR : monotone1 (@trace_forall_ E R PE PR).
-Proof.
-  repeat intro. red in IN. red. induction IN; auto with itree.
-Qed.
+Lemma trace_forall_mono {E R} PE PR : Proper (leq ==> leq) (@trace_forall_ E R PE PR).
+Proof. monauto. Qed.
 
-#[global] Hint Resolve trace_forall_monot : paco.
+Definition trace_forall_mon {E R} PE PR := Build_mon (@trace_forall_mono E R PE PR).
 
-Definition trace_forall {E R} PE PR := paco1 (@trace_forall_ E R PE PR) bot1.
+
+Definition trace_forall {E R} PE PR := gfp (@trace_forall_mon E R PE PR).
 
 Lemma trace_forall_proper_aux: forall (E : Type -> Type) (R : Type) (PE : forall A : Type, EvAns E A -> Prop)
                                  (PR : R -> Prop) (b1 b2 : itree (EvAns E) R),
     (b1 ≈ b2) -> trace_forall PE PR b1 -> trace_forall PE PR b2.
 Proof.
-  intros E R PE PR. pcofix CIH. intros b1 b2 Heutt Hforall.
-  pfold. red. punfold Hforall. red in Hforall.
-  punfold Heutt. red in Heutt. induction Heutt; subst; auto.
+  intros E R PE PR. icoinduction c CIH. intros b1 b2 Heutt Hforall.
+  step in Hforall.
+  step in Heutt. induction Heutt; subst; auto. 
   - inv Hforall. auto with itree.
-  - inv Hforall. pclearbot. constructor. right. eapply CIH; eauto.
-  - inv Hforall. ddestruction. subst. pclearbot.
-    constructor; auto. intros. right. eapply CIH; eauto with itree. apply H3.
-  - apply IHHeutt. inv Hforall. pclearbot. punfold H0.
-  - constructor. left. pfold. red. apply IHHeutt. auto.
+  - inv Hforall.  constructor. eapply CIH; eauto.
+  - inv Hforall. ddestruction. subst. 
+    constructor; auto. intros. eapply CIH. 
+    apply REL. 
+    apply H3.
+  - apply IHHeutt. inv Hforall. now step in H0.
+  - constructor. Utils.step. apply IHHeutt. auto.
 Qed.
 
 #[global] Instance trace_forall_proper_eutt {E R PE PR} : Proper (eutt eq ==> iff) (@trace_forall E R PE PR).
@@ -67,8 +67,8 @@ Qed.
 
 Lemma forall_spin : forall E R PE PR, trace_forall PE PR (@ITree.spin (EvAns E) R).
 Proof.
-  intros. pcofix CIH. pfold. red. cbn. constructor.
-  right. auto.
+  intros. icoinduction c CIH. cbn. constructor.
+  auto. 
 Qed.
 
 Inductive trace_inf_oftenF {E : Type -> Type} {R : Type} (PE : forall A, EvAns E A -> Prop)
@@ -86,14 +86,12 @@ Inductive trace_inf_oftenF {E : Type -> Type} {R : Type} (PE : forall A, EvAns E
 Definition trace_inf_often_ {E R} PE F (b : itrace E R) :=
   trace_inf_oftenF PE F (observe b).
 
-Lemma trace_inf_often_monot {E R} PE : monotone1 (@trace_inf_often_ E R PE).
-Proof.
-  repeat intro. red in IN. red. induction IN; auto with itree.
-Qed.
+Lemma trace_inf_often_mono {E R} PE : Proper (leq ==> leq) (@trace_inf_often_ E R PE).
+Proof. monauto. Qed.
 
-#[global] Hint Resolve trace_inf_often_monot : paco.
+Definition trace_inf_often_mon {E R} PE := Build_mon (@trace_inf_often_mono E R PE).
 
-Definition trace_inf_often {E R} PE := paco1 (@trace_inf_often_ E R PE) bot1.
+Definition trace_inf_often {E R} PE := gfp (@trace_inf_often_mon E R PE).
 
 Inductive front_and_last {E : Type -> Type} {R : Type} (PEF : forall A, EvAns E A -> Prop)
           (PEL : forall A, EvAns E A -> Prop) (PR : R -> Prop) : itrace E R -> Prop :=
@@ -101,7 +99,6 @@ Inductive front_and_last {E : Type -> Type} {R : Type} (PEF : forall A, EvAns E
   b ≈ Vis e (fun u => Ret r) -> PEL unit e -> PR r -> front_and_last PEF PEL PR b
 | front_and_last_cons (e : EvAns E unit) (k : unit -> itrace E R) (b : itree (EvAns E) R ) :
   b ≈ Vis e k -> PEF unit e -> front_and_last PEF PEL PR (k tt) -> front_and_last PEF PEL PR b
-
 .
 
 Lemma fal_proper_aux: forall (E : Type -> Type) (R : Type) (PEF PEL : forall A : Type, EvAns E A -> Prop)
@@ -145,32 +142,33 @@ Section StateMachine.
   Definition state_machine_ F PEv PRet (tr : itrace E R) :=
     state_machineF PEv PRet F (observe tr).
 
-  Lemma monotone_state_machine : monotone3 state_machine_.
-  Proof.
-    red. intros. red. red in IN. induction IN; auto with itree.
-  Qed.
-  Hint Resolve trace_inf_often_monot : paco.
-  Definition state_machine PEv PRet (tr : itrace E R) :  Prop := paco3 (state_machine_) bot3 PEv PRet tr.
+  Lemma state_machine_mono : Proper (leq ==> leq) state_machine_.
+  Proof. monauto. Qed.
+
+  Definition state_machine_mon := Build_mon (state_machine_mono).
+
+  Definition state_machine := gfp (state_machine_mon).
 
   Lemma state_machine_proper_aux : forall PEv PRet (t1 t2 : itrace E R),
       (t1 ≈ t2) -> state_machine PEv PRet t1 -> state_machine PEv PRet t2.
   Proof.
-    pcofix CIH. intros PEV PREt t1 t2 Heutt Hsm. pfold. red.
-    punfold Hsm; try apply monotone_state_machine.
-    punfold Heutt. red in Heutt. red in Hsm.
+    icoinduction c CIH. intros PEV PREt t1 t2 Heutt Hsm. 
+    step in Hsm; try apply monotone_state_machine.
+    step in Heutt.
     induction Hsm.
-    - remember (RetF r0) as ot1. induction Heutt; subst; auto with itree; try discriminate.
+    - remember (RetF r) as ot1. induction Heutt; subst; auto with itree; try discriminate.
       injection Heqot1; intros; subst; auto with itree.
-    - apply IHHsm. pstep_reverse. assert (Tau t ≈ t2); auto with itree.
+    - apply IHHsm. unstep. assert (Tau t ≈ t2) by now step. 
       rewrite tau_eutt in H. auto.
     - remember (VisF (evans A e a) k ) as ot1. induction Heutt; subst; auto with itree; try discriminate.
       injection Heqot1; intros; subst. dependent destruction H1.
-      subst. constructor; auto. right. pclearbot. eapply CIH; eauto with itree.
+      subst. constructor; auto. eapply CIH; try apply REL; eauto. 
   Qed.
 
   #[global] Instance state_machine_proper_eutt {PEv PRet} : Proper (eutt eq ==> iff) (@state_machine PEv PRet).
   Proof.
-    intros t1 t2 Heutt. split; intros; try eapply state_machine_proper_aux; eauto; symmetry; auto.
+    intros t1 t2 Heutt. assert (Heutt2 : t2 ≈ t1) by now symmetry.
+     split; intros; eapply state_machine_proper_aux; eauto. 
   Qed.
 
 End StateMachine.
diff --git a/extra/ITrace/ITracePrefix.v b/extra/ITrace/ITracePrefix.v
index b9f57d2c..b7f485f5 100644
--- a/extra/ITrace/ITracePrefix.v
+++ b/extra/ITrace/ITracePrefix.v
@@ -1,9 +1,10 @@
-From Coq Require Import
+From Stdlib Require Import
      Morphisms
 .
 
+From Coinduction Require Import all. 
+
 From ITree Require Import
-     Basics.Utils
      Axioms
      ITree
      ITreeFacts
@@ -16,8 +17,6 @@ From ITree.Extra Require Import
      ITrace.ITraceFacts
 .
 
-From Paco Require Import paco.
-
 Import Monads.
 Import MonadNotation.
 #[local] Open Scope monad_scope.
@@ -43,19 +42,17 @@ Definition trace_prefix_ {E R S} F (br : itrace E R) (bs : itrace E S) := trace_
 
 #[global] Hint Unfold trace_prefix_ : itree.
 
-Lemma trace_prefix_monot {E R S} : monotone2 (@trace_prefix_ E R S).
-Proof.
-  repeat intro. red. red in IN. induction IN; eauto with itree.
-Qed.
+Lemma trace_prefix_mono {E R S} : Proper (leq ==> leq) (@trace_prefix_ E R S).
+Proof. monauto. Qed.
 
-#[global] Hint Resolve trace_prefix_monot : paco.
+Definition trace_prefix_mon {E R S} := Build_mon (@trace_prefix_mono E R S).
 
-Definition trace_prefix {E R S} : itrace E R -> itrace E S -> Prop := paco2 trace_prefix_ bot2.
+Definition trace_prefix {E R S} : itrace E R -> itrace E S -> Prop := gfp (@trace_prefix_mon E R S).
 
 Lemma prefix_vis : forall E R S A (e : E A) (ans : A) (k : unit -> itrace E R) (t : itrace E S),
     trace_prefix (Vis (evans _ e ans) k ) t -> exists k', (t ≈ Vis (evans _ e ans) k' )%itree.
 Proof.
-  intros E R S A e ans k t Hbp. punfold Hbp. red in Hbp. cbn in *.
+  intros E R S A e ans k t Hbp. step in Hbp. cbn in *.
   dependent induction Hbp.
   - apply simpobs in x. enough (exists k', bs ≈ (Vis (evans A e ans) k' ))%itree.
     + destruct H as [k' Hk']. exists k'. rewrite x. rewrite tau_eutt. auto.
@@ -72,191 +69,193 @@ Qed.
 
 Lemma trace_prefix_proper_aux_vis: forall (E : Type -> Type) (S R : Type)
                                      (t1 : itree (EvAns E) R) (b2 : itrace E R),
-    eqitF eq true true id
-          (upaco2 (eqit_ eq true true id) bot2)
+    eqitF eq true true
+          (eutt eq)
           (observe t1) (observe b2) ->
     forall (r : itrace E R -> itrace E S -> Prop)
       (X : Type) (e : EvAns E X)
       (k : X -> itree (EvAns E) S),
-      trace_prefixF (upaco2 trace_prefix_ bot2)
+      trace_prefixF (gfp trace_prefix_mon)
                     (observe t1) (VisF e k) ->
       (forall (b1 b2 : itrace E R)
          (b : itrace E S),
           (b1 ≈ b2) ->
           trace_prefix b1 b -> r b2 b) ->
-      trace_prefixF (upaco2 trace_prefix_ r)
+      trace_prefixF r
                     (observe b2) (VisF e k).
 Proof.
   intros E S R t1 b2 Heutt r X e k H0 CIH.
   dependent induction H0.
   - rewrite <- x0 in Heutt. dependent induction Heutt.
-    + rewrite <- x. apply trace_prefix_ret.
-    + rewrite <- x. constructor. eapply IHHeutt; eauto.
-  - eapply IHtrace_prefixF; auto.
-    apply simpobs in x. assert (t1 ≈ b2); auto with itree.
-    rewrite x in H. rewrite tau_eutt in H. punfold H.
+    + simpobs. apply trace_prefix_ret.
+    + simpobs. constructor. eapply IHHeutt; eauto.
+  - eapply IHtrace_prefixF. 3: reflexivity. all: eauto. 
+    apply simpobs in x. assert (t1 ≈ b2) by now step.
+    rewrite x in H. rewrite tau_eutt in H. now step in H.
   - rewrite <- x in Heutt. dependent induction Heutt.
-    + rewrite <- x. constructor.
-    + rewrite <- x. constructor. eapply IHHeutt; eauto.
-  - pclearbot. rewrite <- x in Heutt. dependent induction Heutt.
-    + rewrite <- x. constructor. right. pclearbot. eapply CIH; eauto with itree.
-    + rewrite <- x. constructor. eapply IHHeutt; eauto.
+    + simpobs. constructor.
+    + simpobs. constructor. eapply IHHeutt; eauto.
+  - rewrite <- x in Heutt. dependent induction Heutt.
+    + simpobs. constructor. eapply CIH; eauto with itree.
+    + simpobs. constructor. eapply IHHeutt; eauto.
 Qed.
 
 Lemma trace_prefix_tau_inv:
   forall (E : Type -> Type) (S R : Type)
     (m1 : itree (EvAns E) R) (t : itree (EvAns E) S),
-    trace_prefixF (upaco2 trace_prefix_ bot2)
+    trace_prefixF (trace_prefix)
                   (TauF m1) (TauF t) -> trace_prefix m1 t.
 Proof.
   intros E S R m1 t Hbp.
-  dependent induction  Hbp.
-  - pclearbot. auto.
-  - pfold. red. clear IHHbp. dependent induction Hbp.
+  dependent induction Hbp.
+  - auto.
+  - step. clear IHHbp. dependent induction Hbp.
     + rewrite <- x0. auto with itree.
-    + rewrite <- x. constructor. pclearbot. punfold H.
-    + rewrite <- x. constructor. eapply IHHbp; eauto.
+    + simpobs. constructor. now step in H.
+    + simpobs. constructor. eapply IHHbp; eauto.
     + auto.
-  - pfold. red. clear IHHbp. dependent induction Hbp.
-    + rewrite <- x. constructor. pclearbot. punfold H.
+  - step. clear IHHbp. dependent induction Hbp.
+    + simpobs. constructor. now step in H.
     + auto.
-    + rewrite <- x. constructor. eapply IHHbp; eauto.
+    + simpobs. constructor. eapply IHHbp; eauto.
 Qed.
 
 Lemma trace_prefix_proper_l : forall E R S (b1 b2 : itrace E R) (b : itrace E S),
     (b1 ≈ b2) -> trace_prefix b1 b -> trace_prefix b2 b.
 Proof.
-  intros E R S. pcofix CIH. intros b1 b2 b Heutt Hbp.
-  pfold. red. punfold Heutt. red in Heutt. punfold Hbp. red in Hbp.
-  dependent induction Heutt generalizing b1 b2 b.
-  - rewrite <- x. constructor.
-  - rewrite <- x. rewrite <- x0 in Hbp. clear x0 x. pclearbot.
+  intros E R S. icoinduction c CIH. intros b1 b2 b Heutt Hbp.
+  step in Heutt. step in Hbp.
+  dependent induction Heutt.
+  - simpobs. constructor.
+  - simpobs. clear x0 x.
     destruct (observe b) eqn : Heqb.
     + inv Hbp. constructor. dependent induction  H0.
       * apply simpobs in x0. assert (m1 ≈ m2); auto.
         rewrite x0 in H. clear x x0 Heqb CIH REL.
-        punfold H. red in H. cbn in *. dependent induction H.
-        ++ rewrite <- x. apply trace_prefix_ret.
-        ++ rewrite <- x. constructor. eapply IHeqitF; eauto.
-      * eapply IHtrace_prefixF; auto; eauto. (* if we directly eauto something gets unified in an undesired way *)
+        step in H. cbn in *. dependent induction H.
+        ++ simpobs. apply trace_prefix_ret.
+        ++ simpobs. constructor. eapply IHeqitF; eauto.
+      * eapply IHtrace_prefixF. 5: reflexivity. all: auto.
         apply simpobs in x. assert (m1 ≈ m2); auto.
         rewrite x in H. rewrite tau_eutt in H. auto.
-    + constructor. right. eapply CIH; eauto. eapply trace_prefix_tau_inv; eauto.
+    + constructor. eapply CIH; eauto. eapply trace_prefix_tau_inv; eauto.
     + constructor. clear Heqb. inv Hbp. dependent induction H0.
       * apply simpobs in x0. assert (m1 ≈ m2); auto.
-        rewrite x0 in H. punfold H. red in H. cbn in *.
+        rewrite x0 in H. step in H. cbn in *.
         dependent induction H.
-        ++ rewrite <- x. apply trace_prefix_ret.
-        ++ rewrite <- x. constructor. eapply IHeqitF; eauto.
+        ++ simpobs. apply trace_prefix_ret.
+        ++ simpobs. constructor. eapply IHeqitF; try apply x0; eauto. 
            assert (m1 ≈ m2); auto.
-           apply simpobs in x. rewrite x in H0. rewrite tau_eutt in H0. auto.
-      * eapply IHtrace_prefixF; auto.
+           sinv x0. apply simpobs in x, H2. 
+            rewrite x, H2, tau_eutt in H0.
+            now rewrite <- H0, H2. 
+      * eapply IHtrace_prefixF. 4: reflexivity. all: auto.
         assert (m1 ≈ m2); auto. apply simpobs in x.
         rewrite x in H. rewrite tau_eutt in H. auto.
       * assert (m1 ≈ m2); auto. apply simpobs in x.
         rewrite x in H0.
-        punfold H0. red in H0. cbn in *.
+        step in H0. cbn in *.
         dependent induction H0.
-        ++ rewrite <- x. constructor.
-        ++ rewrite <- x. constructor. eapply IHeqitF; eauto.
+        ++ simpobs. constructor.
+        ++ simpobs. constructor. eapply IHeqitF; try apply x0; eauto.
            assert (m1 ≈ m2); auto.
            apply simpobs in x. rewrite x in H1. rewrite tau_eutt in H1. auto.
-      * pclearbot. apply simpobs in x. assert (m1 ≈ m2); auto.
-        rewrite x in H0. punfold H0. red in H0. cbn in *.
+      *  apply simpobs in x. assert (m1 ≈ m2); auto.
+        rewrite x in H0. step in H0. cbn in *.
         dependent induction H0.
-        ++ rewrite <- x. constructor. right. pclearbot. eapply CIH; eauto with itree.
-        ++ rewrite <- x. constructor. eapply IHeqitF; eauto.
+        ++ simpobs. constructor. eapply CIH; try apply REL0; eauto. 
+        ++ simpobs. constructor. eapply IHeqitF; try apply x0; eauto.
            assert (m1 ≈ m2); auto.
            apply simpobs in x. rewrite x in H1. rewrite tau_eutt in H1. auto.
-  - rewrite <- x. rewrite <- x0 in Hbp. clear x x0. pclearbot.
+  - simpobs. clear x x0. 
     dependent induction Hbp.
-    + rewrite <- x. constructor. eapply IHHbp; eauto.
-    + rewrite <- x. constructor.
-    + rewrite <- x. pclearbot. constructor. right. eapply CIH; eauto with itree.
+    + simpobs. constructor. eapply IHHbp; eauto.
+    + simpobs. constructor.
+    + simpobs.  constructor. eapply CIH; try apply REL; eauto with itree.
   - rewrite <- x in Hbp.
     destruct (observe b) eqn : Heqb.
     + clear IHHeutt. inv Hbp. clear Heqb x.
       dependent induction H0.
       * rewrite <- x0 in Heutt. clear CIH x0 x.
         dependent induction  Heutt.
-        ++ rewrite <- x. apply trace_prefix_ret.
-        ++ rewrite <- x. constructor. eapply IHHeutt; eauto.
-      * eapply IHtrace_prefixF; auto.
-        assert (t1 ≈ b2); auto with itree.
-        apply simpobs in x. rewrite x in H. rewrite tau_eutt in H. punfold H.
-    + constructor. eapply IHHeutt; eauto. pstep_reverse. eapply trace_prefix_tau_inv; eauto.
+        ++ simpobs. apply trace_prefix_ret.
+        ++ simpobs. constructor. eapply IHHeutt; eauto.
+      * eapply IHtrace_prefixF. 4: reflexivity. all: auto.
+        assert (t1 ≈ b2) by now step. 
+        apply simpobs in x. rewrite x in H. rewrite tau_eutt in H. now step in H.
+    + constructor. eapply IHHeutt; eauto. unstep. eapply trace_prefix_tau_inv; eauto.
     + clear IHHeutt. inv Hbp. eapply trace_prefix_proper_aux_vis; eauto.
-  - rewrite <- x. constructor. eapply IHHeutt; eauto.
+  - simpobs. constructor. eapply IHHeutt; eauto.
 Qed.
 
 Lemma trace_prefixF_tau_inv_r:
   forall (E : Type -> Type) (S R : Type)
          (t1 : itree (EvAns E) S) (b : itrace E R),
-    trace_prefixF (upaco2 trace_prefix_ bot2)
+    trace_prefixF (trace_prefix)
                   (observe b) (TauF t1) ->
-    trace_prefixF (upaco2 trace_prefix_ bot2)
+    trace_prefixF (trace_prefix)
                   (observe b) (observe t1).
 Proof.
   intros E S R t1 b Hbp.
   dependent induction  Hbp.
   - rewrite <- x0. apply trace_prefix_ret.
-  - pclearbot. rewrite <- x. constructor. punfold H.
-  - rewrite <- x. constructor. eapply IHHbp; eauto.
+  -  simpobs. constructor. now step in H.
+  - simpobs. constructor. eapply IHHbp; eauto.
   - auto.
 Qed.
 
 Lemma trace_prefixF_vis_l:
   forall (E : Type -> Type) (S R : Type)
          (m1 m2 : itree (EvAns E) S),
-    paco2 (eqit_ eq true true id) bot2 m1 m2 ->
+    eutt eq m1 m2 ->
     forall (r : itrace E R -> itrace E S -> Prop)
            (X : Type) (e : EvAns E X)
            (k : X -> itree (EvAns E) R),
-      trace_prefixF (upaco2 trace_prefix_ bot2)
+      trace_prefixF (trace_prefix)
                     (VisF e k) (observe m1) ->
       (forall (b : itrace E R)
               (b1 b2 : itrace E S),
           (b1 ≈ b2) ->
           trace_prefix b b1 -> r b b2 ) ->
-      trace_prefixF (upaco2 trace_prefix_ r)
+      trace_prefixF r
                     (VisF e k) (observe m2).
 Proof.
   intros E S R m1 m2 REL r X e k H1 CIH.
-  punfold REL. red in REL.
+  step in REL.
   dependent induction H1.
-  - eapply IHtrace_prefixF; auto. rewrite <- x in REL.
-    assert (Tau bs ≈ m2).
-    { pfold. auto. }
-    rewrite tau_eutt in H. punfold H.
+  - eapply IHtrace_prefixF. 4: reflexivity. all: auto.
+    rewrite <- x in REL.
+    assert (Tau bs ≈ m2) by now step. 
+    rewrite tau_eutt in H. now step in H.
   - rewrite <- x in REL. dependent induction REL.
-    + rewrite <- x. constructor.
-    + rewrite <- x. constructor. eapply IHREL; eauto.
-  - pclearbot. rewrite <- x in REL. dependent induction REL.
-    + rewrite <- x. constructor. right. pclearbot. eapply CIH; eauto with itree.
-    + rewrite <- x. constructor. eapply IHREL; eauto.
+    + simpobs. constructor.
+    + simpobs. constructor. eapply IHREL; eauto.
+  -  rewrite <- x in REL. dependent induction REL.
+    + simpobs. constructor. eapply CIH; try apply REL; eauto with itree.
+    + simpobs. constructor. eapply IHREL; eauto.
 Qed.
 
 Lemma trace_prefix_proper_r : forall E R S (b : itrace E R) (b1 b2 : itrace E S),
     (b1 ≈ b2) -> trace_prefix b b1 -> trace_prefix b b2.
 Proof.
-  intros E R S. pcofix CIH. intros b b1 b2 Heutt Hbp.
-  punfold Heutt. red in Heutt. punfold Hbp. red in Hbp.
-  pfold. red. dependent induction Heutt.
-  - rewrite <- x. rewrite <- x0 in Hbp. clear x0 x. induction Hbp; auto with itree.
-    + pclearbot. constructor. right. eapply CIH; eauto. reflexivity.
-    + constructor. pclearbot. left. apply pacobot2; eauto.
-  - pclearbot. rewrite <- x0 in Hbp. rewrite <- x. clear x0 x.
+  intros E R S. icoinduction c CIH. intros b b1 b2 Heutt Hbp.
+  step in Heutt. step in Hbp. 
+  dependent induction Heutt.
+  - simpobs. clear x0 x. induction Hbp; auto with itree.
+    +  constructor. eapply CIH; eauto.
+    + constructor. now do 2 ITree.Basics.Utils.step. 
+  -  rewrite <- x0 in Hbp. simpobs. clear x0 x.
     destruct (observe b).
     + apply trace_prefix_ret.
-    + constructor. right. pclearbot. eapply CIH; eauto. apply trace_prefix_tau_inv. auto.
+    + constructor. eapply CIH; eauto. apply trace_prefix_tau_inv. auto.
     + inv Hbp. constructor. eapply trace_prefixF_vis_l; eauto.
-  - rewrite <- x. rewrite <- x0 in Hbp. pclearbot. clear x x0. dependent induction Hbp.
+  - simpobs. clear x x0. dependent induction Hbp.
     + rewrite <- x0. apply trace_prefix_ret.
-    + rewrite <- x. constructor. eapply IHHbp; eauto.
-    + rewrite <- x. constructor.
-    + rewrite <- x. constructor. right. pclearbot. eapply CIH; eauto with itree.
+    + simpobs. constructor. eapply IHHbp; eauto.
+    + simpobs. constructor.
+    + simpobs. constructor. eapply CIH; try apply REL; eauto with itree.
   - eapply IHHeutt; auto. rewrite <- x in Hbp. eapply trace_prefixF_tau_inv_r; eauto.
-  - rewrite <- x. constructor. eapply IHHeutt; eauto.
+  - simpobs. constructor. eapply IHHeutt; eauto.
 Qed.
 
 #[global] Instance trace_prefix_proper {E R S} : Proper (eutt eq ==> eutt eq ==> iff) (@trace_prefix E R S).
@@ -280,8 +279,8 @@ Lemma ind_comb_bind : forall E R S (b1 : itrace E R) (b2 : itrace E S) (b : itra
 Proof.
   intros E R S b1 b2 b Hind. induction Hind.
   - rewrite H. rewrite bind_ret_l. auto.
-  - rewrite H. rewrite H0. rewrite bind_vis. pfold. red. constructor. intros.
-    left. destruct v. apply IHHind.
+  - rewrite H. rewrite H0. rewrite bind_vis. step. constructor. intros.
+    destruct v. apply IHHind.
 Qed.
 
 Inductive trace_prefix_ind {E R S} : itrace E R -> itrace E S -> Prop :=
@@ -296,7 +295,7 @@ Lemma trace_prefix_ind_comb : forall E R S (b1 : itrace E R) (b2 : itrace E S),
     exists b3, ind_comb b1 b3 b2.
 Proof.
   intros E R S b1 b2 Hpre. induction Hpre.
-  - exists b2. econstructor; eauto. reflexivity.
+  - exists b2. econstructor; eauto.
   - destruct IHHpre as [b3 Hb3].
     exists b3. eapply left_vis_comb; eauto.
 Qed.
@@ -318,22 +317,22 @@ Proof.
     apply prefix_vis in Hbp as Hb2.
     destruct Hb2 as [k' Hk']. rewrite Hk' in Hbp.
     eapply left_vis_bp; eauto. destruct b. apply IHHconv.
-    punfold Hbp. red in Hbp. cbn in *. inversion Hbp. subst; ddestruction; subst.
-    pclearbot. auto.
+    step in Hbp. cbn in *. inversion Hbp. subst; ddestruction; subst.
+     auto.
 Qed.
 
-Lemma trace_prefix_div : forall E R S (b1 : itrace E R) (b2 : itrace E S),
+Lemma trace_prefix_div E R S (b1 : itrace E R) (b2 : itrace E S) :
     all_infinite b1 -> trace_prefix b1 b2 -> euttNoRet b1 b2.
 Proof.
-  intros E R S. pcofix CIH. intros b1 b2 Hdiv Hbf. pfold. red.
-  punfold Hbf. red in Hbf. punfold Hdiv. red in Hdiv. induction Hbf.
+  revert b1 b2. icoinduction c CIH. intros b1 b2 Hdiv Hbf.
+  step in Hbf. step in Hdiv. induction Hbf.
   - inv Hdiv.
-  - constructor. inv Hdiv. pclearbot. right. apply CIH; auto.
-  - constructor; auto. apply IHHbf. pstep_reverse. inv Hdiv. pclearbot. auto.
+  - constructor. inv Hdiv. apply CIH; auto.
+  - constructor; auto. apply IHHbf. unstep. inv Hdiv. 
   - constructor; auto.
   - constructor. intros [].
-  - pclearbot. constructor. intros. right. pclearbot. inv Hdiv. ddestruction; subst.
-    pclearbot. destruct v. apply CIH; auto. apply H1.
+  -  constructor. intros. inv Hdiv. ddestruction; subst.
+     destruct v. apply CIH; auto. apply H1.
 Qed.
 
 Lemma trace_prefix_bind : forall E R S (b1 : itrace E R) (b2 : itrace E S),
@@ -342,7 +341,10 @@ Proof.
   intros. destruct (classic_converge b1).
   - destruct H0 as [r Hconv]. eapply converge_trace_prefix in Hconv; eauto.
     apply trace_prefix_ind_bind. auto.
-  - eapply trace_prefix_div in H0 as Heuttdiv; eauto.
+  - (* question why does *)
+    (* eapply trace_prefix_div in H0.  *)
+    (* do that ?*)
+    specialize (@trace_prefix_div E R S b1 b2 H0 H) as Heuttnoret. 
     exists (fun _ => ITree.spin). apply euttNoRet_subrel. apply euttNoRet_sym.
     eapply noret_bind_nop with (f := (fun _ => ITree.spin) ) in H0 as H1.
     eapply euttNoRet_trans; try apply H1. apply euttNoRet_sym. auto.
diff --git a/extra/Secure/SecureEqBind.v b/extra/Secure/SecureEqBind.v
index af1b8867..3cfca27b 100644
--- a/extra/Secure/SecureEqBind.v
+++ b/extra/Secure/SecureEqBind.v
@@ -1,15 +1,17 @@
+From Coinduction Require Import all. 
+
 From ITree Require Import
      Axioms
      ITree
      ITreeFacts.
 
 From ITree.Extra Require Import
+    
      Secure.SecureEqHalt
      Secure.SecureEqWcompat
+     Secure.SecureEqEuttHalt
 .
 
-From Paco Require Import paco.
-
 Import Monads.
 Import MonadNotation.
 Local Open Scope monad_scope.
@@ -22,22 +24,23 @@ Lemma eqit_bind_shalt_aux1:
     (t2 : itree E R2),
     ~ leq (priv A e) l ->
     empty A ->
-    paco2 (secure_eqit_ Label priv RR b1 b2 l id) bot2 (Vis e k0) t2 ->
+    eqit_secure Label priv RR b1 b2 l (Vis e k0) t2 ->
     forall (t1 : itree E R1),
       VisF e k0 = observe t1 ->
-      paco2 (secure_eqit_ Label priv RS b1 b2 l id) bot2 (ITree.bind t1 k1) (ITree.bind t2 k2).
+      eqit_secure Label priv RS b1 b2 l (ITree.bind t1 k1) (ITree.bind t2 k2).
 Proof.
   intros E S2 S1 R1 R2 RR RS b1 b2 Label priv l k1 k2 A e k0 t2 SECCHECK SIZECHECK H0 t1 Heqot1.
-  pstep. red. unfold ITree.bind at 1, observe at 1. cbn. rewrite <- Heqot1.
-  cbn. rewrite itree_eta' at 1. pstep_reverse.
-  generalize dependent t2. pcofix CIH. intros t2 Ht2.
-  pstep. red.
-  punfold Ht2. red in Ht2.
+  step. unfold ITree.bind at 1, observe at 1. cbn. simpobs.
+  cbn. rewrite itree_eta' at 1. unstep. 
+  generalize dependent t2. coinduction c CIH. intros t2 Ht2.
+  step in Ht2. icbn.  
   unfold ITree.bind at 1. unfold observe at 2. cbn in *.
   inv Ht2; ddestruction; subst; try contra_size; try contradiction; try rewrite <- H; cbn;
-  try unpriv_halt; right; eapply CIH;  pclearbot; eauto;
-  try (pfold; rewrite H in H1; apply H1).
-  contra_size.
+  try unpriv_halt; eapply CIH; eauto;
+  try solve [step; rewrite H in H1; apply H1].
+  - now step. 
+  - apply H0. 
+  - contra_size. 
 Qed.
 
 Lemma eqit_bind_shalt_aux2:
@@ -48,77 +51,62 @@ Lemma eqit_bind_shalt_aux2:
     (t1 : itree E R1) (t2 : itree E R2),
     ~ leq (priv A e) l ->
     empty A ->
-    paco2 (secure_eqit_ Label priv RR b1 b2 l id) bot2 t1 (Vis e k0) ->
+    eqit_secure Label priv RR b1 b2 l t1 (Vis e k0) ->
     VisF e k0 = observe t2 ->
-    paco2 (secure_eqit_ Label priv RS b1 b2 l id) bot2 (ITree.bind t1 k1) (ITree.bind t2 k2).
+    eqit_secure Label priv RS b1 b2 l (ITree.bind t1 k1) (ITree.bind t2 k2).
 Proof.
   intros E S2 S1 R1 R2 RR RS b1 b2 Label priv l k1 k2 A e k0 t1 t2 SECCHECK SIZECHECK H0 Heqot1.
-  pstep. red. unfold ITree.bind at 2, observe at 2. cbn. rewrite <- Heqot1.
-  cbn. rewrite itree_eta'. pstep_reverse.
-  generalize dependent t1. pcofix CIH. intros t1 Ht1.
-  pstep. red.
-  punfold Ht1. red in Ht1.
+  step. unfold ITree.bind at 2, observe at 2. cbn. simpobs.
+  cbn. rewrite itree_eta'. unstep.
+  generalize dependent t1. coinduction c CIH. intros t1 Ht1.
+  step in Ht1. icbn.  
   unfold ITree.bind at 1, observe at 1. cbn in *.
   inv Ht1; ddestruction; subst; try contra_size; try contradiction; cbn;
-  try unpriv_halt; try contra_size; try (right; eapply CIH; pclearbot; eauto).
-  pfold. rewrite H0 in H1. auto. apply H1.
+  try unpriv_halt; try contra_size; try (eapply CIH; eauto).
+  - now step. 
+  - rewrite <- H0. step. apply H1. 
+  - apply H1.  
 Qed.
 
-Lemma secure_eqit_bind' : forall E R1 R2 S1 S2 (RR : R1 -> R2 -> Prop) (RS : S1 -> S2 -> Prop)
-                           b1 b2 Label priv l r
-    (t1 : itree E R1) (t2 : itree E R2) (k1 : R1 -> itree E S1) (k2 : R2 -> itree E S2),
-    (forall r1 r2, RR r1 r2 -> paco2 (secure_eqit_ Label priv RS b1 b2 l id) r (k1 r1) (k2 r2) ) ->
-    eqit_secure Label priv RR b1 b2 l t1 t2 ->
-    paco2 (secure_eqit_ Label priv RS b1 b2 l id) r (ITree.bind t1 k1) (ITree.bind t2 k2).
+Ltac to_mon_s := 
+match goal with 
+| |- secure_eqitF ?Label ?priv ?RR ?b1 ?b2 ?l ?sim (observe ?t1) (observe ?t2) =>
+  change (secure_eqit_mon Label priv RR b1 b2 l sim t1 t2)
+  end.
+
+
+Lemma secure_eqit_bind_chain :
+  forall {E R1 R2 S1 S2} (RR : R1 -> R2 -> Prop) (RS : S1 -> S2 -> Prop)
+    b1 b2 (Lab : Preorder) (pr : forall A, E A -> L) (lev : L)
+    (c : Chain (secure_eqit_mon Lab pr RS b1 b2 lev))
+    (t1 : itree E R1) (t2 : itree E R2)
+    (k1 : R1 -> itree E S1) (k2 : R2 -> itree E S2),
+    eqit_secure Lab pr RR b1 b2 lev t1 t2 ->
+    (forall r1 r2, RR r1 r2 -> elem c (k1 r1) (k2 r2)) ->
+    elem c (ITree.bind t1 k1) (ITree.bind t2 k2).
 Proof.
-  intros. revert H0. revert t1 t2. pcofix CIH. intros t1 t2 Ht12.
-  punfold Ht12. red in Ht12.
-  genobs t1 ot1. genobs t2 ot2.
-  hinduction Ht12 before r; intros; eauto.
-  - pstep. red. unfold ITree.bind, observe. unfold observe. cbn.
-    rewrite <- Heqot1. rewrite <- Heqot2. pstep_reverse.
-    eapply paco2_mon; eauto.
-  - pstep. red. unfold ITree.bind, observe. unfold observe. cbn.
-    rewrite <- Heqot1. rewrite <- Heqot2. cbn. constructor. right. eapply CIH. pclearbot.
-    auto.
-  - pstep. red. unfold ITree.bind at 1, observe at 1. cbn.
-    rewrite <- Heqot1. cbn. constructor; auto. pstep_reverse.
-  - pstep. red. unfold ITree.bind at 2, observe at 2. cbn.
-    rewrite <- Heqot2. cbn. constructor; auto. pstep_reverse.
-  - pstep. red. unfold ITree.bind, observe. unfold observe. cbn.
-    rewrite <- Heqot1. rewrite <- Heqot2. cbn. pclearbot.
-    constructor; auto. right. eapply CIH; eauto. apply H.
-  - pstep. red. unfold ITree.bind, observe. unfold observe. cbn.
-    rewrite <- Heqot1. rewrite <- Heqot2. cbn. unpriv_co.
-    right. pclearbot. eapply CIH; apply H.
-  - pstep. red. unfold ITree.bind, observe. unfold observe. cbn.
-    rewrite <- Heqot1. rewrite <- Heqot2. cbn. unpriv_co.
-    right. pclearbot. eapply CIH; apply H.
-  - pstep. red. unfold ITree.bind, observe. unfold observe. cbn.
-    rewrite <- Heqot1. rewrite <- Heqot2. cbn. unpriv_co.
-    right. pclearbot. eapply CIH; apply H.
-  - pstep. red. unfold ITree.bind at 1, observe at 1. cbn.
-    rewrite <- Heqot1. cbn. unpriv_ind. pstep_reverse; try eapply H0; eauto.
-  - pstep. red. unfold ITree.bind at 2, observe at 2. cbn.
-    rewrite <- Heqot2. cbn. unpriv_ind. pstep_reverse; try eapply H0; eauto.
-  - pclearbot.
-    eapply paco2_mon with (r := bot2); intros; try contradiction.
-    eapply eqit_bind_shalt_aux1; eauto. pfold. red. rewrite <- Heqot2.
-    cbn. unpriv_halt. left. eauto.
-  - pclearbot.
-    eapply paco2_mon with (r := bot2); intros; try contradiction.
-    eapply eqit_bind_shalt_aux2; eauto. pfold. red. cbn. rewrite <- Heqot1.
-    unpriv_halt. left. eauto.
-  - pclearbot.
-    eapply paco2_mon with (r := bot2); intros; try contradiction.
-    eapply eqit_bind_shalt_aux1 with (A := A); eauto.
-    pfold. red. rewrite <- Heqot2. cbn. unpriv_halt.
-  - pclearbot.
-    eapply paco2_mon with (r := bot2); intros; try contradiction.
-    eapply eqit_bind_shalt_aux2; eauto. pfold. red. cbn. rewrite <- Heqot1.
-    unpriv_halt.
+  intros E R1 R2 S1 S2 RR RS b1 b2 Lab pr lev c.
+  tower induction.
+  intros IH t1 t2 k1 k2 Hsec Hcont.
+  step in Hsec. genobs t1 ot1. genobs t2 ot2.
+  hinduction Hsec before IH; intros.
+  - apply simpobs in Heqot1. apply simpobs in Heqot2. rewrite Heqot1, Heqot2. repeat rewrite bind_ret_l. now apply Hcont.
+  - apply simpobs in Heqot1. apply simpobs in Heqot2. rewrite Heqot1, Heqot2. repeat rewrite bind_tau. constructor. eapply IH; [apply H | intros rr1 rr2 HRR; apply (b_chain c); now apply Hcont].
+  - apply simpobs in Heqot1. rewrite Heqot1. rewrite bind_tau. constructor; auto. eapply IHHsec; eauto.
+  - apply simpobs in Heqot2. rewrite Heqot2. rewrite bind_tau. constructor; auto. eapply IHHsec; eauto.
+  - apply simpobs in Heqot1. apply simpobs in Heqot2. rewrite Heqot1, Heqot2. repeat rewrite bind_vis. constructor; auto. intros a. eapply IH; [apply H | intros rr1 rr2 HRR; apply (b_chain c); now apply Hcont].
+  - apply simpobs in Heqot1. apply simpobs in Heqot2. rewrite Heqot1, Heqot2. rewrite bind_vis, bind_tau. unpriv_co. eapply IH; [apply H | intros rr1 rr2 HRR; apply (b_chain c); now apply Hcont].
+  - apply simpobs in Heqot1. apply simpobs in Heqot2. rewrite Heqot1, Heqot2. rewrite bind_tau, bind_vis. unpriv_co. eapply IH; [apply H | intros rr1 rr2 HRR; apply (b_chain c); now apply Hcont].
+  - apply simpobs in Heqot1. apply simpobs in Heqot2. rewrite Heqot1, Heqot2. repeat rewrite bind_vis. unpriv_co. eapply IH; [apply H | intros rr1 rr2 HRR; apply (b_chain c); now apply Hcont].
+  - apply simpobs in Heqot1. rewrite Heqot1. rewrite bind_vis. unpriv_ind. eapply H0; eauto.
+  - apply simpobs in Heqot2. rewrite Heqot2. rewrite bind_vis. unpriv_ind. eapply H0; eauto.
+  - apply (gfp_bchain c). eapply eqit_bind_shalt_aux1; eauto. step. rewrite <- Heqot2. cbn. unpriv_halt. eauto.
+  - apply (gfp_bchain c). eapply eqit_bind_shalt_aux2; eauto. step. rewrite <- Heqot1. cbn. unpriv_halt. eauto.
+  - apply (gfp_bchain c). eapply eqit_bind_shalt_aux1 with (e := e1); eauto. step. rewrite <- Heqot2. cbn. unpriv_halt.
+  - apply (gfp_bchain c). eapply eqit_bind_shalt_aux2 with (e := e2); eauto. step. rewrite <- Heqot1. cbn. unpriv_halt.
 Qed.
 
+
 Lemma secure_eqit_bind : forall E R1 R2 S1 S2 (RR : R1 -> R2 -> Prop) (RS : S1 -> S2 -> Prop)
                            b1 b2 Label priv l
     (t1 : itree E R1) (t2 : itree E R2) (k1 : R1 -> itree E S1) (k2 : R2 -> itree E S2),
@@ -126,21 +114,20 @@ Lemma secure_eqit_bind : forall E R1 R2 S1 S2 (RR : R1 -> R2 -> Prop) (RS : S1 -
     eqit_secure Label priv RR b1 b2 l t1 t2 ->
     eqit_secure Label priv RS b1 b2 l (ITree.bind t1 k1) (ITree.bind t2 k2).
 Proof.
-  intros.
-  eapply secure_eqit_bind'; eauto.
-Qed.
+  intros. eapply secure_eqit_bind_chain; eauto. 
+Qed. 
 
 Lemma iter_bind_shalt_aux1:
   forall (E : Type -> Type) (B2 B1 A1 A2 : Type) (RA : A1 -> A2 -> Prop)
     (RB : B1 -> B2 -> Prop) (b1 b2 : bool) (Label : Preorder)
     (priv : forall A : Type, E A -> L) (l : L) (body1 : A1 -> itree E (A1 + B1))
-    (body2 : A2 -> itree E (A2 + B2)) (r : itree E B1 -> itree E B2 -> Prop)
+    (body2 : A2 -> itree E (A2 + B2)) 
     (A : Type) (e : E A) (k1 : A -> itree E (A1 + B1)) (t0 : itree E (A2 + B2)),
     ~ leq (priv A e) l ->
     empty A ->
-    paco2 (secure_eqit_ Label priv (HeterogeneousRelations.sum_rel RA RB) b1 b2 l id) bot2
+    eqit_secure Label priv (HeterogeneousRelations.sum_rel RA RB) b1 b2 l
           (Vis e k1) t0 ->
-    paco2 (secure_eqit_ Label priv RB b1 b2 l id) r
+    eqit_secure Label priv RB b1 b2 l
           (Vis e
                (fun x : A =>
                   ITree.bind (k1 x)
@@ -156,26 +143,29 @@ Lemma iter_bind_shalt_aux1:
                          | inr r0 => Ret r0
                          end)).
 Proof.
-  intros E B2 B1 A1 A2 RA RB b1 b2 Label priv l body1 body2 r A e k1 t0 SECCHECK SIZECHECK H.
-  generalize dependent t0. pcofix CIH. intros t0 Ht0.
-  pstep. red. cbn. unfold observe. cbn. punfold Ht0.
-  red in Ht0. cbn in *. inv Ht0; inv_vis_secure; cbn; pclearbot; unpriv_halt; try contra_size;
-    right; eauto.
-  eapply CIH; eauto.
-  rewrite H in H1. pfold. red. auto.
+  intros E B2 B1 A1 A2 RA RB b1 b2 Label priv l body1 body2 A e k1 t0 SECCHECK SIZECHECK H.
+  generalize dependent t0. coinduction c CIH. intros t0 Ht0.
+  icbn. step in Ht0. rewrite observe_bind.   
+   cbn in *. inv Ht0; inv_vis_secure; cbn;  unpriv_halt; try contra_size;
+    eauto.
+  all: 
+  eapply CIH; eauto. 
+  - now step.
+  - simpobs. now step. 
+  - apply H0. 
 Qed.
 
 Lemma iter_bind_shalt_aux2:
   forall (E : Type -> Type) (B2 B1 A1 A2 : Type) (RA : A1 -> A2 -> Prop)
     (RB : B1 -> B2 -> Prop) (b1 b2 : bool) (Label : Preorder)
     (priv : forall A : Type, E A -> L) (l : L) (body1 : A1 -> itree E (A1 + B1))
-    (body2 : A2 -> itree E (A2 + B2)) (r : itree E B1 -> itree E B2 -> Prop)
+    (body2 : A2 -> itree E (A2 + B2)) 
     (A : Type) (e : E A) (t0 : itree E (A1 + B1)) (k2 : A -> itree E (A2 + B2)),
     ~ leq (priv A e) l ->
     empty A ->
-    paco2 (secure_eqit_ Label priv (HeterogeneousRelations.sum_rel RA RB) b1 b2 l id) bot2 t0
+    eqit_secure Label priv (HeterogeneousRelations.sum_rel RA RB) b1 b2 l t0
           (Vis e k2) ->
-    paco2 (secure_eqit_ Label priv RB b1 b2 l id) r
+    eqit_secure Label priv RB b1 b2 l
           (ITree.bind t0
                       (fun lr : A1 + B1 =>
                          match lr with
@@ -191,24 +181,30 @@ Lemma iter_bind_shalt_aux2:
                                 | inr r0 => Ret r0
                                 end))).
 Proof.
-  intros E B2 B1 A1 A2 RA RB b1 b2 Label priv l body1 body2 r A e t0 k2 SECCHECK SIZECHECK H.
-  generalize dependent t0. pcofix CIH. intros t0 Ht0.
-  pstep. red. cbn. unfold observe. cbn. punfold Ht0.
-  red in Ht0. cbn in *. inv Ht0; inv_vis_secure; cbn; pclearbot; unpriv_halt; try contra_size;
-  try (right; eauto).
+  intros E B2 B1 A1 A2 RA RB b1 b2 Label priv l body1 body2 A e t0 k2 SECCHECK SIZECHECK H.
+  generalize dependent t0. coinduction c CIH. intros t0 Ht0.
+  icbn. step in Ht0.
+  rewrite observe_bind.   
+   cbn in *. inv Ht0; inv_vis_secure; cbn;  unpriv_halt; try contra_size;
+    eauto.
+  all: 
   eapply CIH; eauto.
-  rewrite H0 in H1. pfold. red. auto.
+  - now step.
+  - simpobs. now step. 
+  - apply H1.
 Qed.
 
 Lemma iter_bind_aux:
   forall (E : Type -> Type) (B2 B1 A1 A2 : Type) (RA : A1 -> A2 -> Prop)
     (RB : B1 -> B2 -> Prop) (b1 b2 : bool) (Label : Preorder)
     (priv : forall A : Type, E A -> L) (l : L) (body1 : A1 -> itree E (A1 + B1))
-    (body2 : A2 -> itree E (A2 + B2)) (r : itree E B1 -> itree E B2 -> Prop)
+    (body2 : A2 -> itree E (A2 + B2)) 
+    (c : Chain (secure_eqit_mon Label priv RB b1 b2 l))
     (t1 : itree E (A1 + B1)) (t2 : itree E (A2 + B2)),
-    paco2 (secure_eqit_ Label priv (HeterogeneousRelations.sum_rel RA RB) b1 b2 l id) bot2 t1 t2 ->
-    (forall (a1 : A1) (a2 : A2), RA a1 a2 -> r (ITree.iter body1 a1) (ITree.iter body2 a2)) ->
-    paco2 (secure_eqit_ Label priv RB b1 b2 l id) r
+    eqit_secure Label priv (HeterogeneousRelations.sum_rel RA RB) b1 b2 l t1 t2 ->
+    (forall (a1 : A1) (a2 : A2)
+    , RA a1 a2 -> elem c (ITree.iter body1 a1) (ITree.iter body2 a2)) ->
+    elem c
           (ITree.bind t1
                       (fun lr : A1 + B1 =>
                          match lr with
@@ -222,22 +218,36 @@ Lemma iter_bind_aux:
                          | inr r0 => Ret r0
                          end)).
 Proof.
-  intros E B2 B1 A1 A2 RA RB b1 b2 Label priv l body1 body2 r t1 t2 H CIH0.
-  generalize dependent t2. revert t1. pcofix CIH1.
-  intros t1 t2 Ht12. punfold Ht12. pstep. red.
-  unfold observe. cbn.
-  hinduction Ht12 before r; intros; cbn; eauto; pclearbot;
+  intros E B2 B1 A1 A2 RA RB b1 b2 Label priv l body1 body2 c. 
+  tower induction. intros CIH t1 t2 Ht12 Hbody. step in Ht12. 
+  icbn. 
+  unfold observe. cbn. 
+  hinduction Ht12 before E; intros; simpobs; cbn; eauto; 
   try (unpriv_co; fail);
-  try (constructor; auto; pclearbot; right; eapply CIH1; eauto with itree; fail).
+  try (constructor; auto;  right; eapply CIH1; eauto with itree; fail).
   - inv H; cbn; eauto with itree.
-  - unpriv_ind. unfold observe at 1. cbn. eapply H0; eauto with itree.
-  - unpriv_ind. unfold observe at 3. cbn. eapply H0; eauto with itree.
-  - unpriv_halt. left. eapply iter_bind_shalt_aux1; eauto with itree.
-  - unpriv_halt. left. eapply iter_bind_shalt_aux2; eauto with itree.
-  - unpriv_halt. specialize (H b). left. eapply iter_bind_shalt_aux1; eauto with itree.
-  - unpriv_halt. specialize (H a). left. eapply iter_bind_shalt_aux2; eauto with itree.
-Qed.
+    constructor. now step; apply Hbody. 
+  - constructor; auto. eapply CIH; eauto with itree.
+    intros. now step; apply Hbody. 
+  - constructor; auto. unfold observe at 1. cbn. eapply IHHt12; eauto with itree. 
+  - constructor; auto. unfold observe at 1. cbn. eapply IHHt12; eauto with itree. 
+  - constructor; auto. intro. 
+    eapply CIH; intros. apply H.
+    now step; apply Hbody.
 
+  - unpriv_co. eapply CIH; intros. apply H.
+      now step; apply Hbody.
+  - unpriv_co. eapply CIH; intros. apply H.
+      now step; apply Hbody.
+  - unpriv_co. eapply CIH; intros. apply H. 
+      now step; apply Hbody.
+  - unpriv_ind. unfold observe at 1. cbn. eapply H0; eauto with itree.
+  - unpriv_ind. unfold observe at 3. cbn. apply H0; eauto with itree.
+  - unpriv_halt. do 2 step. eapply iter_bind_shalt_aux1; eauto with itree.
+  - unpriv_halt. do 2 step. eapply iter_bind_shalt_aux2; eauto with itree.
+  - unpriv_halt. specialize (H b). do 2 step. eapply iter_bind_shalt_aux1; eauto with itree.
+  - unpriv_halt. specialize (H a). do 2 step. eapply iter_bind_shalt_aux2; eauto with itree.
+Qed. 
 
 Lemma secure_eqit_iter : forall E A1 A2 B1 B2 (RA : A1 -> A2 -> Prop) (RB : B1 -> B2 -> Prop)
                            b1 b2 Label priv l
@@ -252,32 +262,35 @@ Proof.
   guclo eqit_bind_clo. *)
 
   (* look into the more general secure_eqitC closure, see if that is weakly compatible, *)
-  pcofix CIH.
+  icoinduction c CIH.
   intros a1 a2 Ha. specialize (Hbody a1 a2 Ha) as Hbodya.
-  punfold Hbodya. red in Hbodya. pfold. red.
-  unfold observe. (* write lemmas for unfolding the observe of iter *) cbn.
-  hinduction Hbodya before r; intros; cbn; auto with itree.
-  - inv H; cbn; eauto with itree.
-  - cbn. pclearbot. constructor.
-    left. eapply iter_bind_aux; eauto.
-  - constructor; auto. pclearbot. left. eapply iter_bind_aux; eauto.
-  - unpriv_co. pclearbot. left. eapply iter_bind_aux; eauto.
-  -  unpriv_co. pclearbot. left. eapply iter_bind_aux; eauto.
-  - unpriv_co. pclearbot. left. eapply iter_bind_aux; eauto.
+  step in Hbodya.
+  unfold observe.
+   (* write lemmas for unfolding the observe of iter *) cbn.
+  hinduction Hbodya before E; intros; cbn; auto with itree.
+  - inv H; cbn; eauto with itree. 
+  - cbn. constructor. 
+    eapply iter_bind_aux; eauto. 
+  - constructor; auto. intro. eapply iter_bind_aux; eauto.
+      apply H. 
+  - unpriv_co.  
+    eapply iter_bind_aux; eauto. apply H. 
+  - unpriv_co. eapply iter_bind_aux; eauto. apply H. 
+  - unpriv_co. eapply iter_bind_aux; eauto. apply H. 
   - unpriv_ind. (* here is  where it gets bad, I am pretty sure H0 does match up but could
                   take very particular *) unfold observe at 1. cbn.
     eauto.
   - unpriv_ind. unfold observe at 3. cbn. eauto.
-  - pclearbot. unpriv_halt.
-    left. eapply iter_bind_shalt_aux1; eauto.
-  - unpriv_halt. pclearbot. left. eapply iter_bind_shalt_aux2; eauto.
-  - unpriv_halt. pclearbot. specialize (H b). left.
-    eapply iter_bind_shalt_aux1; eauto.
-  - unpriv_halt. pclearbot. specialize (H a). left. eapply iter_bind_shalt_aux2; eauto.
+  -  unpriv_halt. do 2 step. 
+      eapply iter_bind_shalt_aux1; eauto. 
+  - unpriv_halt. do 2 step.  eapply iter_bind_shalt_aux2; eauto.
+  - unpriv_halt.  specialize (H b). do 2 step. 
+    eapply iter_bind_shalt_aux1; eauto. 
+  - unpriv_halt.  specialize (H a). do 2 step. eapply iter_bind_shalt_aux2; eauto.
 Qed.
 
 Lemma secure_eqit_ret : forall (E : Type -> Type) Label priv l b1 b2 (R1 R2 : Type) (RR : R1 -> R2 -> Prop) (r1 : R1) (r2 : R2),
     RR r1 r2 -> @eqit_secure E R1 R2 Label priv RR b1 b2 l (Ret r1) (Ret r2).
 Proof.
-  intros. pfold. constructor. auto.
+  intros. step. constructor. auto.
 Qed.
diff --git a/extra/Secure/SecureEqEuttHalt.v b/extra/Secure/SecureEqEuttHalt.v
index 2c863927..69100bb1 100644
--- a/extra/Secure/SecureEqEuttHalt.v
+++ b/extra/Secure/SecureEqEuttHalt.v
@@ -1,4 +1,6 @@
-From Coq Require Import Morphisms.
+From Coinduction Require Import all. 
+
+From Stdlib Require Import Morphisms.
 
 From ITree Require Import
      Axioms
@@ -10,21 +12,117 @@ From ITree.Extra Require Import
      Secure.SecureEqHalt
 .
 
-From Paco Require Import paco.
-
 Import Monads.
 Import MonadNotation.
 Local Open Scope monad_scope.
 
+
+
+#[local] Ltac taul := apply secEqTauL; [auto|].
+#[local] Ltac taur := apply secEqTauR; [auto|].
+
+#[global] Instance eq_itree_proper_secureC {E R1 R2} b1 b2 Label priv (RR : R1 -> R2 -> Prop) l
+  (c : Chain (secure_eqit_mon Label priv RR b1 b2 l)) : 
+  Proper (eq_itree (E := E) eq ==> eq_itree eq ==> iff) (elem c).
+  Proof with eauto with itree.
+  unfold Proper, respectful; split; 
+  rename H into EQx; rename H0 into EQy;
+  rename x0 into x'; rename y0 into y'. 
+  all: revert x y EQx x' y' EQy. 
+  all: tower induction; 
+       intros IH x x' EQx y y' EQy EQ; step in EQx; step in EQy.
+  all: icbn; icbn in EQ; cbn in *. 
+  1: genobs x ox; genobs y oy; 
+    revert x x' y y' Heqox Heqoy EQx EQy.
+  2: genobs x' ox'; genobs y' oy'; 
+      revert x x' y y' Heqox' Heqoy' EQx EQy.
+  all: induction EQ; intros. 
+  5-8, 19-22 : inv EQx; inv EQy; ddestruction; subst; try contradiction; try contra_size; eauto with itree.
+  
+    + clear x y Heqox Heqoy.
+      genobs x' ox'.
+      genret r1 or1.
+      revert x' Heqox'.
+      hinduction EQx before ox'; try easy.
+      * intros; subst; inv Heqor1. clear x' Heqox'.
+        genobs y' oy'; genret r2 or2.
+        revert y' Heqoy'.
+        hinduction EQy before oy'; try easy.
+        subst; intros [=<-] ??...
+  (* the 2 proof bodies are identical from here.
+     some automation above with the 5-8, 19-22 line, 
+     and more could be done, though it really wants
+     for better parallel machinery. just synced lines would be good. *)
+    + inv EQx; inv EQy. constructor. eapply IH; eauto. 
+    + inv EQx. taul. eapply IHEQ; eauto. now unstep. 
+    + inv EQy. taur. eapply IHEQ; eauto. now unstep.
+    + inv EQx; ddestruction. constructor; auto. intros. 
+      eapply H0; eauto. now unstep. 
+    + inv EQy; ddestruction. constructor; auto. intros. 
+      eapply H0; eauto. now unstep. 
+    + inv EQx; inv EQy; ddestruction; subst; try easy.  
+      constructor 11; eauto. eapply IH. 
+      2, 3: eauto. step. constructor. auto. 
+    + inv EQx; inv EQy; ddestruction; subst; try easy.  
+      constructor 12; eauto. eapply IH. 
+      1, 3: eauto. step. constructor. auto. 
+    + inv EQx; inv EQy; ddestruction; subst; try easy.  
+      constructor 13; eauto. intro. eapply IH.
+      3: apply H. step; now constructor. apply REL0. 
+    + inv EQx; inv EQy; ddestruction; subst; try easy.  
+      constructor 14; eauto. intro. eapply IH.
+      3: apply H. apply REL.
+       step; now constructor. 
+
+  + clear x' y' Heqox' Heqoy'.
+      genobs x ox.
+      genret r1 or1.
+      revert x Heqox.
+      hinduction EQx before ox; try easy.
+      * intros; subst; inv Heqor1. clear x Heqox.
+        genobs y oy; genret r2 or2.
+        revert y Heqoy.
+        hinduction EQy before oy; try easy.
+        subst; intros [=<-] ??...
+    + inv EQx; inv EQy. constructor. eapply IH; eauto. 
+    + inv EQx. taul. eapply IHEQ; eauto. now unstep. 
+    + inv EQy. taur. eapply IHEQ; eauto. now unstep.
+    + inv EQx; ddestruction. constructor; auto. intros. 
+      eapply H0; eauto. now unstep. 
+    + inv EQy; ddestruction. constructor; auto. intros. 
+      eapply H0; eauto. now unstep. 
+    + inv EQx; inv EQy; ddestruction; subst; try easy.  
+      constructor 11; eauto. eapply IH. 
+      2, 3: eauto. step. constructor. auto. 
+    + inv EQx; inv EQy; ddestruction; subst; try easy.  
+      constructor 12; eauto. eapply IH. 
+      1, 3: eauto. step. constructor. auto. 
+    + inv EQx; inv EQy; ddestruction; subst; try easy.  
+      constructor 13; eauto. intro. eapply IH.
+      3: apply H. step; now constructor. apply REL0. 
+    + inv EQx; inv EQy; ddestruction; subst; try easy.  
+      constructor 14; eauto. intro. eapply IH.
+      3: apply H. apply REL.
+       step; now constructor. 
+Qed. 
+
+#[global] Instance eq_itree_proper_secureC_mon {E R1 R2} b1 b2 Label priv (RR : R1 -> R2 -> Prop) l
+  (c : Chain (secure_eqit_mon Label priv RR b1 b2 l)) :
+  Proper (eq_itree (E := E) eq ==> eq_itree eq ==> Basics.flip Basics.impl)
+         (secure_eqit_mon Label priv RR b1 b2 l (elem c)).
+Proof.
+  repeat intro. eapply eq_itree_proper_secureC with (c := chain_b c); eauto.
+Qed.
+
 Lemma tau_eqit_secure : forall E R1 R2 Label priv l RR (t1 : itree E R1) (t2 : itree E R2),
     eqit_secure Label priv RR true true l (Tau t1) t2 -> eqit_secure Label priv RR true true l t1 t2.
 Proof.
-  intros E R1 R2 Label priv l RR.  intros t1 t2 Hsec. pstep. red.
-  punfold Hsec. red in Hsec. cbn in *. remember (TauF t1) as x.
-  hinduction Hsec before priv; intros;  inv Heqx; pclearbot; try inv CHECK; auto with itree.
-  - constructor; auto. pstep_reverse.
-  - unpriv_ind. pstep_reverse.
-  - punfold H.
+  intros E R1 R2 Label priv l RR.  intros t1 t2 Hsec. step. 
+  step in Hsec. cbn in *. remember (TauF t1) as x.
+  hinduction Hsec before priv; intros; inv Heqx; eauto with itree.
+  - constructor; auto. now unstep. 
+  - unpriv_ind. now unstep. 
+  - now step in H.
 Qed.
 
 Lemma unpriv_e_eqit_secure : forall E A R1 R2 Label priv l RR (e : E A) (k : A -> itree E R1)
@@ -34,88 +132,132 @@ Lemma unpriv_e_eqit_secure : forall E A R1 R2 Label priv l RR (e : E A) (k : A -
     forall a, eqit_secure Label priv RR true true l (k a) t.
 Proof.
   intros. generalize dependent t. rename H into Hunpriv. generalize dependent a.
-  intros. punfold H0. red in H0. cbn in *. pfold. red.
+  intros. step in H0. cbn in *. step. 
   remember (VisF e k) as x. genobs_clear t ot.
   hinduction H0 before l; intros; try inv Heqx;
     ddestruction; subst; try contradiction; try contra_size; auto.
   - constructor; auto. eapply IHsecure_eqitF; eauto.
-  - pclearbot. constructor; auto. pstep_reverse.
-  - unpriv_ind. pstep_reverse. pclearbot. apply H.
+  -  constructor; auto. now unstep. 
+  - unpriv_ind. unstep.  apply H.
   - unpriv_ind. eapply H0; eauto.
-  - pclearbot. rewrite itree_eta'. pstep_reverse.
+  -  rewrite itree_eta'. now now unstep. 
 Qed.
 
 
-(* reformat this lemma? useful but unclear *)
-Lemma eses_aux1: forall (E : Type -> Type) (R2 R1 : Type) (Label : Preorder)
+Lemma eses_au_vis_r: forall (E : Type -> Type) (R2 R1 : Type) (Label : Preorder)
                     (priv : forall A : Type, E A -> L) (l : L) (RR : R1 -> R2 -> Prop)
-                    (r : itree E R1 -> itree E R2 -> Prop) (m1 m2 : itree E R1),
-              m1 ≈ m2 ->
-               (forall (t1 t1' : itree E R1) (t2 : itree E R2),
-                   t1 ≈ t1' -> eqit_secure Label priv RR true true l t1 t2 -> r t1' t2) ->
-               forall (X : Type) (e : E X) (k : X -> itree E R2),
-                 secure_eqitF Label priv RR true true l id
-                              (upaco2 (secure_eqit_ Label priv RR true true l id) bot2) (observe m1)
-                              (VisF e k) ->
-                 leq (priv X e) l ->
-                 secure_eqitF Label priv RR true true l id
-                              (upaco2 (secure_eqit_ Label priv RR true true l id) r) (observe m2)
-                              (VisF e k).
+                    (r : itree E R1 -> itree E R2 -> Prop)
+                    (m1 m2 : itree E R1),
+    m1 ≈ m2 ->
+    (forall (t1 t1' : itree E R1) (t2 : itree E R2),
+        t1 ≈ t1' -> eqit_secure Label priv RR true true l t1 t2 -> r t1' t2) ->
+    forall (X : Type) (e : E X) (k : X -> itree E R2),
+      secure_eqitF Label priv RR true true l
+        (eqit_secure Label priv RR true true l) (observe m1) (VisF e k) ->
+      leq (priv X e) l ->
+      secure_eqitF Label priv RR true true l r (observe m2) (VisF e k).
 Proof.
   intros E R2 R1 Label priv l RR r m1 m2 REL CIH X e k Hsec SECCHECK.
-  remember (VisF e k) as x. punfold REL. red in REL. rewrite Heqx.
-  hinduction Hsec before r; intros; try inv Heqx; ddestruction; subst; try contradiction; auto.
+  remember (VisF e k) as x. step in REL. rewrite Heqx.
+  hinduction Hsec before E; intros; try inv Heqx; ddestruction; subst; try contradiction; auto.
   - eapply IHHsec; eauto.
-    pstep_reverse. setoid_rewrite <- tau_eutt at 1. pfold. auto.
-  - pclearbot. remember (VisF e0 k1) as y.
-    hinduction REL before r; intros; try inv Heqy; ddestruction; subst; auto.
-    + constructor; auto. right. eapply CIH; eauto; try apply H.
-      pclearbot. apply REL.
+    unstep. setoid_rewrite <- tau_eutt at 1. step. auto.
+  -  remember (VisF e0 k1) as y.
+    hinduction REL before CIH; intros; try inv Heqy; ddestruction; subst; auto.
+    + constructor; auto. intros.
+      eapply CIH; try apply H.
+      apply REL.
     + constructor; eauto.
   - rewrite H2. remember (VisF e k1) as y.
-    hinduction REL before r; intros; try inv Heqy; ddestruction; subst; auto.
-    + pclearbot. rewrite <- H2. unpriv_ind. rewrite H2. eapply H0; eauto.
-      Unshelve. all: auto. pstep_reverse.
+    hinduction REL before e; intros; try inversion Heqy. ddestruction.
+    + rewrite <- H2. unpriv_ind.  rewrite H2. eapply H0; eauto.
+      Unshelve. all: auto. now now unstep. 
     + constructor; auto. eapply IHREL; eauto.
 Qed.
 
-Lemma eses_aux2:
-forall (E : Type -> Type) (R2 R1 : Type) (Label : Preorder)
-    (priv : forall A : Type, E A -> L) (l : L) (RR : R1 -> R2 -> Prop)
-    (r : itree E R1 -> itree E R2 -> Prop) (m1 m2 : itree E R1) (r0 : R2),
-  m1 ≈ m2 ->
-  secure_eqitF Label priv RR true true l id
-    (upaco2 (secure_eqit_ Label priv RR true true l id) bot2) (observe m1)
-    (RetF r0) ->
-  secure_eqitF Label priv RR true true l id
-    (upaco2 (secure_eqit_ Label priv RR true true l id) r) (observe m2)
-    (RetF r0).
+Lemma eses_au_vis_l: forall (E : Type -> Type) (R2 R1 : Type) (Label : Preorder)
+                    (priv : forall A : Type, E A -> L) (l : L) (RR : R1 -> R2 -> Prop)
+                    (r : itree E R1 -> itree E R2 -> Prop)
+                    (m1 m2 : itree E R2),
+    m1 ≈ m2 ->
+    (forall (t1 : itree E R1) (t2 t2' : itree E R2),
+        t2 ≈ t2' -> eqit_secure Label priv RR true true l t1 t2 -> r t1 t2') ->
+    forall (X : Type) (e : E X) (k : X -> itree E R1),
+      secure_eqitF Label priv RR true true l
+        (eqit_secure Label priv RR true true l) (VisF e k) (observe m1) ->
+      leq (priv X e) l ->
+      secure_eqitF Label priv RR true true l r (VisF e k) (observe m2).
+Proof.
+  intros E R2 R1 Label priv l RR r m1 m2 REL CIH X e k Hsec SECCHECK.
+  remember (VisF e k) as x. step in REL. rewrite Heqx.
+  hinduction Hsec before E; intros; try inv Heqx; ddestruction; subst; try contradiction; auto.
+  - eapply IHHsec; eauto.
+    unstep. setoid_rewrite <- tau_eutt at 1. step. auto.
+  -  remember (VisF e0 k2) as y.
+    hinduction REL before CIH; intros; try inv Heqy; ddestruction; subst; auto.
+    + constructor; auto. intros.
+      eapply CIH; try apply H.
+      apply REL.
+    + constructor; eauto.
+  - rewrite H2. remember (VisF e k2) as y.
+    hinduction REL before e; intros; try inversion Heqy. ddestruction.
+    + rewrite <- H2. unpriv_ind.  rewrite H2. eapply H0; eauto.
+      Unshelve. all: auto. now now unstep. 
+    + constructor; auto. eapply IHREL; eauto.
+Qed.
+
+Lemma eses_aux_ret_r:
+  forall (E : Type -> Type) (R2 R1 : Type) (Label : Preorder)
+    (priv : forall A : Type, E A -> L) (l : L) (RR : R1 -> R2 -> Prop) (m1 m2 : itree E R1) (r0 : R2)
+    (r : itree E R1 -> itree E R2 -> Prop),
+    m1 ≈ m2 ->
+    secure_eqitF Label priv RR true true l
+      (eqit_secure Label priv RR true true l) (observe m1) (RetF r0) ->
+    secure_eqitF Label priv RR true true l r (observe m2) (RetF r0).
 Proof.
-  intros E R2 R1 Label priv l RR r m1 m2 r0 Heutt Hsec.
-  punfold Heutt. red in Heutt. remember (RetF r0) as x.
-  rewrite Heqx. hinduction Hsec before r; intros; inv Heqx; auto with itree.
+  intros E R2 R1 Label priv l RR m1 m2 r0 r Heutt Hsec.
+  step in Heutt. remember (RetF r0) as x.
+  rewrite Heqx. hinduction Hsec before E; intros; inv Heqx; auto with itree.
   - remember (RetF r1) as y.
-    hinduction Heutt before r; intros; inv Heqy; auto with itree.
+    hinduction Heutt before E; intros; inv Heqy; auto with itree.
     constructor; auto. eapply IHHeutt; eauto.
-  - eapply IHHsec; eauto. pstep_reverse. rewrite <- tau_eutt at 1. pfold. auto.
+  - eapply IHHsec; eauto. unstep. rewrite <- tau_eutt at 1. step. auto.
   - remember (VisF e k1) as y.
-    hinduction Heutt before r; intros; inv Heqy; ddestruction; subst; auto.
+    hinduction Heutt before E; intros; inv Heqy; ddestruction; subst; auto.
     +  unpriv_ind. rewrite H2. eapply H0; eauto.
-       pclearbot. pstep_reverse.
+        now now unstep. 
     + constructor; auto. eapply IHHeutt; eauto.
 Qed.
 
 Definition classic_empty := Secure.Labels.classic_empty.
+(* #[global] Instance eutt_secure_secure_eqit_mon 
+    (c : Chain (secure_eqit_mon Label priv RR true true l)): 
+    Proper (eutt eq ==> eq ==> Basics.flip Basics.impl)
+     (elem c).
+Proof.
+  do 5 red. tower induction; subst. 
+  clear c. intros c. intros CIH t1 t1' Heutt t2 _ <- Hsec. 
+  step in Heutt. icbn; icbn in Hsec.  
+  hinduction Heutt before E; intros; subst; auto with itree.
+  (* - remember (RetF r2) as x. hinduction Hsec before E; intros; try inv Heqx; auto with itree.
+    + constructor; auto. eapply IHHsec; eauto.
+    + unpriv_ind. eapply H0; eauto. *)
+  - genobs t2 ot2. clear Heqot2. 
+    assert (Ht2 : (exists m3, ot2 = TauF m3) \/ (forall m3, ot2 <> TauF m3) ).
+    { destruct ot2; eauto; right; repeat intro; discriminate. }
+    (* because of the extra inductive cases this is not enough *)
+    destruct Ht2 as [ [m3 Hm3] | Ht2 ].
+    + subst.  constructor. eapply CIH; eauto. *)
+
 
-(*tomorrow start on the transitivity proof *)
 Lemma eutt_secure_eqit_secure : forall E Label priv l R1 R2 RR (t1 t1': itree E R1) (t2 : itree E R2),
     t1 ≈ t1' -> eqit_secure Label priv RR true true l t1 t2 ->
     eqit_secure Label priv RR true true l t1' t2.
 Proof.
-  intros E Label priv l R1 R2 RR. pcofix CIH. intros t1 t1' t2 Heutt Hsec.
-  punfold Heutt. red in Heutt. punfold Hsec. red in Hsec.
-  pfold. red. hinduction Heutt before r; intros; subst; auto with itree.
-  - remember (RetF r2) as x. hinduction Hsec before r; intros; try inv Heqx; auto with itree.
+  intros E Label priv l R1 R2 RR. icoinduction c CIH. intros t1 t1' t2 Heutt Hsec.
+  step in Heutt. step in Hsec. 
+  hinduction Heutt before E; intros; subst; auto with itree.
+  - remember (RetF r2) as x. hinduction Hsec before E; intros; try inv Heqx; auto with itree.
     + constructor; auto. eapply IHHsec; eauto.
     + unpriv_ind. eapply H0; eauto.
   - genobs_clear t2 ot2.
@@ -123,74 +265,73 @@ Proof.
     { destruct ot2; eauto; right; repeat intro; discriminate. }
     (* because of the extra inductive cases this is not enough *)
     destruct Ht2 as [ [m3 Hm3] | Ht2 ].
-    + subst. pclearbot. constructor. right. eapply CIH; eauto.
+    + subst.  constructor. eapply CIH; eauto.
       apply tau_eqit_secure. apply eqit_secure_sym. apply tau_eqit_secure.
-      apply eqit_secure_sym. pfold. auto.
+      apply eqit_secure_sym. step. auto.
     + destruct ot2; try (exfalso; eapply Ht2; eauto; fail).
-      * pclearbot. rewrite itree_eta' at 1. eapply eses_aux2 with (m1 := Tau m1); eauto.
-        do 2 rewrite tau_eutt. auto.
+      *  rewrite itree_eta' at 1.
+         eapply eses_aux_ret_r with (m1 := Tau m1); eauto.
+         now do 2 rewrite tau_eutt.
       * assert (leq (priv _ e) l \/ ~ leq (priv _ e) l).
         { apply classic. }
         destruct H as [SECCHECK | SECCHECK]; destruct ( classic_empty X  ).
-        ++ pclearbot. rewrite itree_eta' at 1. apply eses_aux1 with (m1 := Tau m1); auto.
+        ++  rewrite itree_eta' at 1. apply eses_au_vis_r with (m1 := Tau m1); auto.
            do 2 rewrite tau_eutt. auto.
-        ++ pclearbot. rewrite itree_eta' at 1. apply eses_aux1 with (m1 := Tau m1); auto.
+        ++  rewrite itree_eta' at 1. apply eses_au_vis_r with (m1 := Tau m1); auto.
            do 2 rewrite tau_eutt. auto.
-        ++ unpriv_halt. pclearbot. right. eapply CIH; eauto.
-           apply tau_eqit_secure. pfold. auto.
-        ++ pclearbot.
-           unpriv_co. pclearbot. right. eapply CIH. apply REL.
+        ++ unpriv_halt. eapply CIH; eauto.
+           apply tau_eqit_secure. step. auto.
+        ++ unpriv_co.  eapply CIH.  apply REL.
            apply tau_eqit_secure.
            apply eqit_secure_sym.
            eapply unpriv_e_eqit_secure; eauto.
-           apply eqit_secure_sym. pfold. auto.
-  - pclearbot. rewrite itree_eta' at 1. pstep_reverse.
-    assert (eqit_secure Label priv RR true true l (Vis e k1) t2 ).
-    { pfold; auto. }
+           apply eqit_secure_sym. step. auto.
+  - assert (eqit_secure Label priv RR true true l (Vis e k1) t2 )
+    by now step. 
     clear Hsec. rename H into Hsec.
     destruct (classic (leq (priv _ e) l ) ).
-    + pstep. red. punfold Hsec. red in Hsec.
+    + step in Hsec.   
       cbn in *. remember (VisF e k1) as x.
-      hinduction Hsec before r; intros; inv Heqx; ddestruction; subst; try contradiction; auto.
+      hinduction Hsec before E; intros; inv Heqx; ddestruction; subst; try contradiction; auto.
       * constructor; auto. eapply IHHsec; eauto.
-      * constructor; auto; intros. right. eapply CIH; try apply REL. pclearbot. apply H.
+      * constructor; auto; intros. eapply CIH; try apply REL.  apply H.
       * rewrite itree_eta' at 1. unpriv_ind. eapply H0; eauto.
     + destruct (classic_empty u).
-      * pfold. red. cbn.  punfold Hsec. red in Hsec. cbn in *.
+      * step in Hsec. cbn in *.
         destruct (observe t2).
         -- inv Hsec; contra_size.
-        -- unpriv_halt. right. apply CIH with (t1 := Vis e k1).
-           ++ pfold. constructor. left. auto.
-           ++ inv Hsec; ddestruction; subst; try contradiction;  try contra_size. pfold. auto.
-              pclearbot. auto.
+        -- unpriv_halt. apply CIH with (t1 := Vis e k1).
+           ++ step. constructor. auto.
+           ++ inv Hsec; ddestruction; subst; try contradiction;  try contra_size. step. auto.
+               auto.
         -- inv Hsec; ddestruction; subst; try contradiction; try contra_size.
-           ++ unpriv_halt. right. apply CIH with (t1 := Vis e k1).
-              { pfold. constructor. red. auto. }
-              { rewrite H1 in H3. pfold. apply H3. }
-           ++ pclearbot. unpriv_halt. right. apply CIH with (t1 := Vis e k1).
-              { pfold. constructor. red. auto. }
+           ++ unpriv_halt. apply CIH with (t1 := Vis e k1).
+              { step. constructor. red. auto. }
+              { rewrite H1 in H3. step. apply H3. }
+           ++  unpriv_halt. apply CIH with (t1 := Vis e k1).
+              { step. constructor. red. auto. }
               { apply H2. }
-           ++ pclearbot. unpriv_halt. contra_size.
-      * pfold. red. cbn.  punfold Hsec. red in Hsec. cbn in *.
+           ++  unpriv_halt. contra_size.
+      * step in Hsec. cbn in *.
         destruct (observe t2).
-        ++ rewrite itree_eta' at 1. rewrite itree_eta' in Hsec at 1.
-           eapply eses_aux2; eauto. pfold. constructor. red. auto.
-        ++ unpriv_co. right. apply CIH with (t1 := k1 a); try apply REL.
+        ++ eapply eses_aux_ret_r with (m1 := Vis e k1) (m2 := Vis e k2); eauto.
+           step. constructor. red. auto.
+        ++ unpriv_co. apply CIH with (t1 := k1 a); try apply REL.
            eapply unpriv_e_eqit_secure; eauto. apply eqit_secure_sym.
-           apply tau_eqit_secure. apply eqit_secure_sym. pfold. auto.
+           apply tau_eqit_secure. apply eqit_secure_sym. step. auto.
         ++ destruct (classic (leq (priv _ e0) l )).
            ** rewrite itree_eta' at 1.
-              eapply eses_aux1 with (m1 := Vis e k1); eauto.
-              pfold. constructor. red. auto.
+              eapply eses_au_vis_r with (m1 := Vis e k1); eauto.
+              step. constructor. red. auto.
            ** destruct (classic_empty X).
-              --- unpriv_halt. right. eapply CIH; try apply REL.
-                  eapply unpriv_e_eqit_secure; eauto. pfold. auto.
-              --- unpriv_co. right. eapply CIH; try apply REL.
+              --- unpriv_halt. eapply CIH; try apply REL.
+                  eapply unpriv_e_eqit_secure; eauto. step. auto.
+              --- unpriv_co. eapply CIH; try apply REL.
                   (* eapply unpriv_e_eqit_secure; eauto. *)
                   do 2 (eapply unpriv_e_eqit_secure; eauto; apply eqit_secure_sym).
-                  pfold. auto.
-  - eapply IHHeutt; eauto. pstep_reverse.
-    apply tau_eqit_secure. pfold. auto.
+                  step. auto.
+  - eapply IHHeutt; eauto. unstep.
+    apply tau_eqit_secure. step. auto.
 Qed.
 
 
@@ -202,30 +343,30 @@ Lemma eqit_secure_TauLR :
     eqit_secure Label priv RR2 b1 b2 l t0 t4.
 Proof.
   intros E R3 Label priv l b1 b2 R2 RR2.
-  intros. punfold H. red in H. cbn in *. pstep. red.
+  intros. step in H. cbn in *. step. cbn.
   remember (TauF t0) as x. remember (TauF t4) as y.
   hinduction H before b2; intros;  try discriminate.
-  - inv Heqx; inv Heqy. pclearbot. pstep_reverse.
+  - inv Heqx; inv Heqy. now unstep. 
   - inv Heqx. inv H; eauto with itree.
-    + pclearbot. unpriv_ind. pstep_reverse.
+    +  unpriv_ind. now unstep. 
     + unpriv_ind. rewrite H1 in H2.
       specialize (H2 a). genobs (k1 a) ok1. clear Heqok1.
       remember (TauF t4) as y.
-      hinduction H2 before b2; intros; inv Heqy; try inv CHECK; eauto with itree.
-      * pclearbot. constructor; auto; pstep_reverse.
-      * pclearbot. unpriv_ind. pstep_reverse.
-      * pclearbot. punfold H.
-    + pclearbot. punfold H2.
+      hinduction H2 before b2; intros; inv Heqy; eauto with itree.
+      *  constructor; auto; now unstep. 
+      *  unpriv_ind. now unstep. 
+      * now step in H.
+    + now step in H2.
   - inv Heqy. inv H; eauto with itree.
-    + pclearbot. unpriv_ind. pstep_reverse.
+    +  unpriv_ind. now unstep. 
     + rewrite H0 in H2. unpriv_ind. specialize (H2 a).
       genobs (k2 a) ok2. clear Heqok2.
       remember (TauF t0) as y.
-      hinduction H2 before b2; intros; inv Heqy; try inv CHECK; eauto with itree.
-      * pclearbot. constructor; auto. pstep_reverse.
-      * unpriv_ind. pclearbot. pstep_reverse.
-      * pclearbot. punfold H.
-    + pclearbot. punfold H2.
+      hinduction H2 before b2; intros; inv Heqy; eauto with itree.
+      *  constructor; auto. now unstep. 
+      * unpriv_ind.  now unstep. 
+      * now step in H.
+    + now step in H2.
 Qed.
 
 Lemma eqit_secure_TauLVisR:
@@ -237,25 +378,25 @@ Lemma eqit_secure_TauLVisR:
       eqit_secure Label priv RR2 b1 b2 l t3 (k a).
 Proof.
   intros E R3 Label priv l b1 b2 R2 RR t3 A e k a He Hsec.
-  punfold Hsec. red in Hsec. cbn in *.
+  step in Hsec. cbn in *.
   remember (TauF t3) as x. remember (VisF e k) as y.
   hinduction Hsec before b2; intros; try discriminate.
   - inv Heqx. inv CHECK.
-    remember (VisF e k) as y. pfold. red. clear IHHsec.
+    remember (VisF e k) as y. step. clear IHHsec.
     hinduction Hsec before b2; intros; inv Heqy; ddestruction;  subst;
     try contradiction; try contra_size; eauto with itree.
-    + constructor; auto. pclearbot. pstep_reverse.
-    + unpriv_ind. pclearbot. pstep_reverse.
-    + pclearbot. specialize (H a). punfold H.
-  - inv Heqx. inv Heqy. ddestruction; subst. pclearbot. apply H.
+    + constructor; auto.  now unstep. 
+    + unpriv_ind.  now unstep. 
+    +  specialize (H a). now step in H.
+  - inv Heqx. inv Heqy. ddestruction; subst.  apply H.
   - inv Heqx. inv Heqy. ddestruction; subst. rewrite H2 in H.
     clear H0. clear H2 t1. remember (TauF t3) as x.
-    pfold. red. specialize (H a).
+    step. specialize (H a).
     hinduction H before b2; intros; inv Heqx; try contra_size; eauto with itree.
-    + pclearbot. constructor; auto. pstep_reverse.
-    + pclearbot. unpriv_ind. pstep_reverse.
-    + pclearbot. punfold H.
-  -  pclearbot. inv Heqx. inv Heqy. ddestruction; subst. contra_size.
+    +  constructor; auto. now unstep. 
+    +  unpriv_ind. now unstep. 
+    + now step in H.
+  -   inv Heqx. inv Heqy. ddestruction; subst. contra_size.
 Qed.
 
 Lemma eqit_secure_TauRVisL:
@@ -267,24 +408,24 @@ Lemma eqit_secure_TauRVisL:
       eqit_secure Label priv RR2 b1 b2 l (k a) t3.
 Proof.
   intros E R3 Label priv l b1 b2 R2 RR t3 A e k a He Hsec.
-  punfold Hsec. red in Hsec. cbn in *.
+  step in Hsec. cbn in *.
   remember (TauF t3) as x. remember (VisF e k) as y.
   hinduction Hsec before b2; intros; try discriminate.
-  - inv Heqx. inv CHECK. remember (VisF e k) as y. pfold. red. clear IHHsec.
+  - inv Heqx. inv CHECK. remember (VisF e k) as y. step. clear IHHsec.
     hinduction Hsec before b1; intros; inv Heqy; ddestruction; subst;
     try contradiction; eauto with itree.
-    + constructor; auto with itree. pclearbot. pstep_reverse.
-    + unpriv_ind. pclearbot. pstep_reverse.
+    + constructor; auto with itree.  now unstep. 
+    + unpriv_ind.  now unstep. 
     + contra_size.
     + contra_size.
-    + pclearbot. specialize (H a). punfold H.
-  - inv Heqx. inv Heqy. ddestruction; subst. pclearbot. apply H.
-  - inv Heqx. inv Heqy. ddestruction; subst. pclearbot. rewrite H2 in H. inv CHECK.
-    specialize (H a). pfold. red. remember (TauF t3) as y.
+    +  specialize (H a). now step in H.
+  - inv Heqx. inv Heqy. ddestruction; subst.  apply H.
+  - inv Heqx. inv Heqy. ddestruction; subst.  rewrite H2 in H. inv CHECK.
+    specialize (H a). step. remember (TauF t3) as y.
     hinduction H before b2; intros; inv Heqy; try contra_size; eauto with itree.
-    + pclearbot. constructor; auto. pstep_reverse.
-    + pclearbot. unpriv_ind. pstep_reverse.
-    + pclearbot. punfold H.
+    +  constructor; auto. now unstep. 
+    +  unpriv_ind. now unstep. 
+    + now step in H.
   - inv Heqx. inv Heqy. ddestruction; subst. contra_size.
 Qed.
 
@@ -300,29 +441,28 @@ Lemma eqit_secure_VisLR:
         eqit_secure Label priv RR2 b1 b2 l (k2 a) (k a0).
 Proof.
   intros E R3 Label priv l b1 b2 R2 RR2 A e k2 SECCHECK X e0 k a H0 a0 H1.
-  pfold. red.
-  punfold H1. red in H1. cbn in *. remember (VisF e k2) as x.
+  step.
+  step in H1. cbn in *. remember (VisF e k2) as x.
   remember (VisF e0 k) as y.
   hinduction H1 before l; intros; try discriminate.
   - inv Heqx. inv Heqy. ddestruction; subst. contradiction.
-  - pclearbot. inv Heqx. inv Heqy. ddestruction; subst. pstep_reverse.
+  -  inv Heqx. inv Heqy. ddestruction; subst. now unstep. 
   - inv Heqx. ddestruction; subst. inv CHECK. clear H0.
     specialize (H a).
     rewrite Heqy in H. clear Heqy. remember (VisF e1 k) as y.
     hinduction H before l; intros; inv Heqy; ddestruction; subst; try contradiction;
     try contra_size; eauto with itree.
-    + pclearbot. constructor; auto. pstep_reverse.
-    + unpriv_ind. pclearbot. pstep_reverse.
-    + pclearbot. specialize (H a0). punfold H.
-
+    +  constructor; auto. now unstep. 
+    + unpriv_ind.  now unstep. 
+    +  specialize (H a0). now step in H.
   - inv Heqy.  ddestruction; subst. inv CHECK. clear H0.
     rewrite Heqx in H. specialize (H a0).
     remember (VisF e0 k0) as y.
     hinduction H before b1; intros; inv Heqy; ddestruction; subst; try contradiction;
     try contra_size; eauto with itree.
-    + pclearbot. constructor; auto. pstep_reverse.
-    + pclearbot. unpriv_ind. pstep_reverse.
-    + pclearbot. specialize (H a). punfold H.
+    +  constructor; auto. now unstep. 
+    +  unpriv_ind. now unstep. 
+    +  specialize (H a). now step in H.
   - inv Heqx; inv Heqy; ddestruction; subst. contra_size.
   - inv Heqx; inv Heqy; ddestruction; subst. contra_size.
 Qed.
@@ -340,7 +480,7 @@ Lemma eqit_secure_private_VisLR:
         eqit_secure Label priv RR2 b1 b2 l (k2 a) (k a0)) ->
         eqit_secure Label priv RR2 b1 b2 l (Vis e k2) (Vis e0 k) .
 Proof.
-  intros. pfold. red. cbn. unpriv_co. left. apply H3.
+  intros. step. cbn. unpriv_co.
 Qed.
 
 Lemma eqit_secure_private_VisL:
@@ -353,7 +493,7 @@ Lemma eqit_secure_private_VisL:
         eqit_secure Label priv RR2 true b2 l (k2 a) t) ->
         eqit_secure Label priv RR2 true b2 l (Vis e k2) t .
 Proof.
-  intros. pfold. red. cbn. unpriv_ind. pstep_reverse. apply H1.
+  intros. step. cbn. unpriv_ind. unstep. apply H1.
 Qed.
 
 Lemma eqit_secure_private_VisR:
@@ -366,7 +506,7 @@ Lemma eqit_secure_private_VisR:
         eqit_secure Label priv RR2 b1 true l t (k2 a)) ->
         eqit_secure Label priv RR2 b1 true l t (Vis e k2).
 Proof.
-  intros. pfold. red. cbn. unpriv_ind. pstep_reverse. apply H1.
+  intros. step. cbn. unpriv_ind. unstep. apply H1.
 Qed.
 
 Lemma eqit_secure_public_Vis :  forall (E : Type -> Type) (R1 R2 : Type) (Label : Preorder) (priv : forall x : Type, E x -> L)
@@ -377,8 +517,8 @@ Lemma eqit_secure_public_Vis :  forall (E : Type -> Type) (R1 R2 : Type) (Label
     forall a, eqit_secure Label priv RR b1 b2 l (k1 a) (k2 a)).
 Proof.
   split; intros.
-  - pinversion H0; ddestruction; subst; try contradiction; apply H2.
-  - pfold. constructor; auto. left. apply H0.
+  - sinv H0; ddestruction; subst; try contradiction; apply H2.
+  - step. constructor; auto. 
 Qed.
 
 Lemma eqit_secure_trans_aux1:
@@ -386,36 +526,36 @@ Lemma eqit_secure_trans_aux1:
     (priv : forall x : Type, E x -> L) (l : L) (b2 : bool) (R2 : Type)
     (RR1 : R1 -> R2 -> Prop) (RR2 : R2 -> R3 -> Prop) (r : itree E R1 -> itree E R3 -> Prop)
     (r0 : R3) (t4 : itree E R2),
-    secure_eqitF Label priv RR2 true b2 l id
-                 (upaco2 (secure_eqit_ Label priv RR2 true b2 l id) bot2) (observe t4)
+    secure_eqitF Label priv RR2 true b2 l
+                 (eqit_secure Label priv RR2 true b2 l) (observe t4)
                  (RetF r0) ->
     forall t : itree E R1,
-      paco2 (secure_eqit_ Label priv RR1 true b2 l id) bot2 t t4 ->
-      secure_eqitF Label priv (rcompose RR1 RR2) true b2 l id
-                   (upaco2 (secure_eqit_ Label priv (rcompose RR1 RR2) true b2 l id) r)
+      eqit_secure Label priv RR1 true b2 l t t4 ->
+      secure_eqitF Label priv (rcompose RR1 RR2) true b2 l
+                   r
                    (observe t) (RetF r0).
 Proof.
   intros E R3 R1 Label priv l b2 R2 RR1 RR2 r r0 t4 Ht23 t H.
-  punfold H. red in H.
+  step in H. cbn in H.
   remember (RetF r0) as x.
-  hinduction Ht23 before r; intros; inv Heqx; try inv CHECK; auto.
+  hinduction Ht23 before E; intros; inv Heqx; auto.
   - remember (RetF r1) as y.
-    hinduction H0 before r; intros; inv Heqy; eauto with itree.
+    hinduction H0 before E; intros; inv Heqy; eauto with itree.
     rewrite itree_eta'. unpriv_ind. cbn. eapply H0; eauto.
   - eapply IHHt23; eauto.
     remember (TauF t1) as y.
-    hinduction H before r; intros; inv Heqy; try inv CHECK; eauto with itree.
-    + pclearbot. constructor; auto. pstep_reverse.
-    + pclearbot. unpriv_ind. pstep_reverse.
-    + pclearbot. punfold H.
+    hinduction H before E; intros; inv Heqy; eauto with itree.
+    +  constructor; auto. now unstep. 
+    +  unpriv_ind. now unstep. 
+    +  now step in H.
   - assert (Hne : nonempty A). { eauto. } (* add the condition that lets us assume this*)
     inv Hne. eapply (H0 a); eauto.
     remember (VisF e k1) as y.
-    hinduction H1 before r; intros; inv Heqy; try inv CHECK; ddestruction; subst;
+    hinduction H1 before E; intros; inv Heqy; ddestruction; subst;
     try contradiction; try contra_size; eauto with itree.
-    + pclearbot. constructor; auto. pstep_reverse.
-    + pclearbot. unpriv_ind. pstep_reverse.
-    + pclearbot. rewrite itree_eta' at 1. pstep_reverse.
+    +  constructor; auto. now unstep. 
+    +  unpriv_ind. now unstep. 
+    +  rewrite itree_eta' at 1. now unstep. 
 Qed.
 
 Lemma eqit_secure_trans_aux2:
@@ -424,41 +564,40 @@ Lemma eqit_secure_trans_aux2:
     (RR1 : R1 -> R2 -> Prop) (RR2 : R2 -> R3 -> Prop) (r : itree E R1 -> itree E R3 -> Prop)
     (X : Type) (e0 : E X) (k : X -> itree E R3) (t4 : itree E R2),
     leq (priv X e0) l ->
-    secure_eqitF Label priv RR2 true b2 l id
-                 (upaco2 (secure_eqit_ Label priv RR2 true b2 l id) bot2) (observe t4)
+    secure_eqitF Label priv RR2 true b2 l
+                 (eqit_secure Label priv RR2 true b2 l) (observe t4)
                  (VisF e0 k) ->
     (forall (t1 : itree E R1) (t2 : itree E R2) (t3 : itree E R3),
         eqit_secure Label priv RR1 true b2 l t1 t2 ->
         eqit_secure Label priv RR2 true b2 l t2 t3 -> r t1 t3) ->
     forall t : itree E R1,
-      paco2 (secure_eqit_ Label priv RR1 true b2 l id) bot2 t t4 ->
-      secure_eqitF Label priv (rcompose RR1 RR2) true b2 l id
-                   (upaco2 (secure_eqit_ Label priv (rcompose RR1 RR2) true b2 l id) r)
+      eqit_secure Label priv RR1 true b2 l t t4 ->
+      secure_eqitF Label priv (rcompose RR1 RR2) true b2 l
+                   r
                    (observe t) (VisF e0 k).
 Proof.
   intros E R3 R1 Label priv l b2 R2 RR1 RR2 r X e0 k t4 He0 Ht23 CIH0 t Ht.
-  punfold Ht. red in Ht. remember (VisF e0 k) as x.
-  hinduction Ht23 before r; intros; inv Heqx; try inv CHECK;
+  step in Ht. cbn in Ht. remember (VisF e0 k) as x.
+  hinduction Ht23 before E; intros; inv Heqx;
   ddestruction; subst; try contradiction; eauto.
   - eapply IHHt23; eauto. clear IHHt23. remember (TauF t1) as y.
-    hinduction Ht before r; intros; inv Heqy; try inv CHECK; eauto with itree.
-    + pclearbot. constructor; auto. pstep_reverse.
-    + pclearbot. unpriv_ind. pstep_reverse.
-    + pclearbot. punfold H.
-  - pclearbot. remember (VisF e0 k1) as y.
-    hinduction Ht before r; intros; inv Heqy; try inv CHECK;
+    hinduction Ht before E; intros; inv Heqy; eauto with itree.
+    +  constructor; auto. now unstep. 
+    +  unpriv_ind. now unstep. 
+    +  now step in H.
+  -  remember (VisF e0 k1) as y.
+    hinduction Ht before E; intros; inv Heqy;
     ddestruction; subst; try contradiction; eauto with itree.
-    + pclearbot. constructor; auto. right. eapply CIH0. apply H.
-      apply H0.
+    +  constructor; auto. intros. eapply CIH0. apply H. apply H0.
     + rewrite itree_eta'. unpriv_ind. eapply H0; eauto.
   - assert (nonempty A); eauto. inv H1. eapply H0; eauto.
     Unshelve. all : auto. clear H0. rewrite H2 in H.
     remember (VisF e k1) as y.
-    hinduction Ht before r; intros; inv Heqy; try inv CHECK; ddestruction; subst;
+    hinduction Ht before E; intros; inv Heqy; ddestruction; subst;
     try contradiction; try contra_size; eauto with itree.
-    + pclearbot. constructor; auto. pstep_reverse.
-    + pclearbot. unpriv_ind. pstep_reverse.
-    + pclearbot. rewrite itree_eta' at 1. pstep_reverse.
+    +  constructor; auto. now unstep. 
+    +  unpriv_ind. now unstep. 
+    +  rewrite itree_eta' at 1. now unstep. 
 
 Qed.
 
@@ -473,59 +612,58 @@ Lemma secret_halt_trans_1 : forall E Label priv l b1 b2 (R1 R2 R3 A : Type) (RR1
 Proof.
   intros E Label priv l b1 b2 R1 R2 R3 A RR1 RR2 t1 e k t3 He HA.
   generalize dependent t3. generalize dependent t1.
-  pcofix CIH. intros t1 t3 Ht1 Ht3.
-  pfold. red. punfold Ht1. red in Ht1. punfold Ht3. red in Ht3.
-  cbn in *.
+  icoinduction c CIH. intros t1 t3 Ht1 Ht3.
+  step in Ht1. step in Ht3. cbn in *.
   remember (VisF e k) as x.
-  hinduction Ht1 before r; intros; inv Heqx; ddestruction; subst;
+  hinduction Ht1 before c; intros; inv Heqx; ddestruction; subst;
   try contradiction; try contra_size; eauto with itree.
-  - pclearbot. inv Ht3; ddestruction; subst; try contradiction; try contra_size.
-    + constructor. right. apply CIH; auto. pfold. auto.
-    + unpriv_co; auto. right. apply CIH; auto. pfold. rewrite H0 in H2. apply H2.
-    + pclearbot. constructor. right. apply CIH; auto.
-    + pclearbot. destruct (classic_empty B).
-      * unpriv_halt. right. apply CIH; auto with itree. pfold.
-        red. cbn. unpriv_halt.
-      * unpriv_co. right. apply CIH; auto. apply H1.
-    + pclearbot. unpriv_halt. right. apply CIH; auto. pfold.
-      red. cbn. unpriv_halt. contra_size.
-  - pclearbot.  inv Ht3; ddestruction; subst; try contradiction; try contra_size.
-    + unpriv_halt. right. apply CIH; auto.
-      * pfold. red. cbn. unpriv_halt.
-      * pfold. auto.
-    + unpriv_halt. right. apply CIH; auto.
-      * pfold. red. cbn. unpriv_halt.
-      * pfold. auto. rewrite H0 in H2. apply H2.
-    + pclearbot. unpriv_halt. right. apply CIH; auto.
-      pfold. red. cbn. unpriv_halt.
-    + pclearbot. unpriv_halt. right. apply CIH.
-      * pfold. red. cbn. unpriv_halt.
+  -  inv Ht3; ddestruction; subst; try contradiction; try contra_size.
+    + constructor. apply CIH; auto. step. auto.
+    + unpriv_co; auto. apply CIH; auto. step. rewrite H0 in H2. apply H2.
+    +  constructor. apply CIH; auto.
+    +  destruct (classic_empty B).
+      * unpriv_halt. apply CIH; auto with itree. step.
+        cbn. unpriv_halt.
+      * unpriv_co. apply CIH; auto. apply H1.
+    +  unpriv_halt. apply CIH; auto. step.
+      cbn. unpriv_halt. contra_size.
+  -   inv Ht3; ddestruction; subst; try contradiction; try contra_size.
+    + unpriv_halt. apply CIH; auto.
+      * step. cbn. unpriv_halt.
+      * step. auto.
+    + unpriv_halt. apply CIH; auto.
+      * step. cbn. unpriv_halt.
+      * step. auto. rewrite H0 in H2. apply H2.
+    +  unpriv_halt. apply CIH; auto.
+      step. cbn. unpriv_halt.
+    +  unpriv_halt. apply CIH.
+      * step. cbn. unpriv_halt.
       * apply H1.
     + unpriv_halt. contra_size.
-  - pclearbot. inv Ht3; ddestruction; subst; try contradiction; try contra_size;
+  -  inv Ht3; ddestruction; subst; try contradiction; try contra_size;
     destruct (classic_empty A0).
-    + unpriv_halt. right. apply CIH; auto.
-      * pfold. red. cbn. unpriv_halt. contra_size.
-      * pfold. auto.
-    + unpriv_co. right. apply CIH; auto; try apply H.
-      pfold. auto.
-    + unpriv_halt. right. apply CIH; auto.
-      * pfold. red. cbn. unpriv_halt. contra_size.
-      * pfold. rewrite H0 in H2. apply H2.
-    + unpriv_co. right. apply CIH. apply H. rewrite H0 in H2.
-      pfold. apply H2.
-    + pclearbot. unpriv_halt. right. apply CIH; auto. pfold.
-      red. cbn. unpriv_halt. contra_size.
-    + pclearbot. unpriv_co. right. apply CIH; auto. apply H.
-    + unpriv_halt. pclearbot. right. apply CIH; try apply H1.
-      pfold. red. cbn. unpriv_halt. contra_size.
-    + pclearbot. destruct (classic_empty B).
-      * unpriv_halt. right. apply CIH; auto. apply H.
-        pfold. red. cbn. unpriv_halt.
-      * unpriv_co. right. apply CIH; eauto. apply H. apply H1.
-    + pclearbot. unpriv_halt. contra_size.
-    + pclearbot. unpriv_halt. right. apply CIH; auto. apply H.
-      pfold. red. cbn. unpriv_halt. contra_size.
+    + unpriv_halt. apply CIH; auto.
+      * step. cbn. unpriv_halt. contra_size.
+      * step. auto.
+    + unpriv_co. apply CIH; auto; try apply H.
+      step. auto.
+    + unpriv_halt. apply CIH; auto.
+      * step. cbn. unpriv_halt. contra_size.
+      * step. rewrite H0 in H2. apply H2.
+    + unpriv_co. apply CIH. apply H. rewrite H0 in H2.
+      step. apply H2.
+    +  unpriv_halt. apply CIH; auto. step.
+      cbn. unpriv_halt. contra_size.
+    +  unpriv_co. apply CIH; auto. apply H.
+    + unpriv_halt. apply CIH; try apply H1.
+      step. cbn. unpriv_halt. contra_size.
+    +  destruct (classic_empty B).
+      * unpriv_halt. apply CIH; auto. apply H.
+        step. cbn. unpriv_halt.
+      * unpriv_co. apply CIH; eauto. apply H. apply H1.
+    +  unpriv_halt. contra_size.
+    +  unpriv_halt. apply CIH; auto. apply H.
+      step. cbn. unpriv_halt. contra_size.
 Qed.
 
 Lemma secret_halt_trans_2 :  forall E Label priv l b1 b2 (R1 R2 R3 A : Type) (RR1 : R1 -> R2 -> Prop)
@@ -538,60 +676,59 @@ Lemma secret_halt_trans_2 :  forall E Label priv l b1 b2 (R1 R2 R3 A : Type) (RR
 Proof.
   intros E Label priv l b1 b2 R1 R2 R3 A RR1 RR2 e k t2 t3 He HA.
   generalize dependent t3. generalize dependent t2.
-  pcofix CIH. intros t2 t3 Ht2 Ht23. pfold.
-  red. cbn. punfold Ht2. punfold Ht23. red in Ht2. red in Ht23.
-  cbn in *.
-  hinduction Ht23 before r; intros; eauto with itree.
+  icoinduction c CIH. intros t2 t3 Ht2 Ht23.
+  step in Ht2. step in Ht23. cbn in *.
+  hinduction Ht23 before c; intros; eauto with itree.
   - inv Ht2. ddestruction; subst. contra_size.
-  - unpriv_halt. right. pclearbot. eapply CIH; eauto.
-    inv Ht2; ddestruction; subst; try contra_size; try contradiction; pclearbot;  eauto.
-    pfold. auto.
+  - unpriv_halt. eapply CIH; eauto.
+    inv Ht2; ddestruction; subst; try contra_size; try contradiction;   eauto.
+    step. auto.
   - eapply IHHt23; eauto.
-    inv Ht2; ddestruction; subst; try contra_size; try contradiction; pclearbot; eauto.
-    punfold H0.
-  - pclearbot.
-    inv Ht2; ddestruction; subst; try contra_size; try contradiction; pclearbot; eauto.
-  - unpriv_halt. pclearbot.  inv SIZECHECK. right. eapply CIH; try apply H.
+    inv Ht2; ddestruction; subst; try contra_size; try contradiction;  eauto.
+    step in H0. auto.
+  -
+    inv Ht2; ddestruction; subst; try contra_size; try contradiction;  eauto.
+  - unpriv_halt.   inv SIZECHECK. eapply CIH; try apply H.
     Unshelve. all : auto.
-    inv Ht2; ddestruction; subst; try contra_size; try contradiction; pclearbot; eauto.
-    + pfold. apply H2.
+    inv Ht2; ddestruction; subst; try contra_size; try contradiction;  eauto.
+    + step. apply H2.
     + apply H1.
-  - pclearbot. unpriv_halt. right. eapply CIH; try apply H.
-    inv Ht2; ddestruction; subst; try contra_size; try contradiction; pclearbot; eauto.
-    pfold. auto.
-  - pclearbot. unpriv_halt. inv SIZECHECK1. inv SIZECHECK2. right. eapply CIH; try apply H.
+  -  unpriv_halt. eapply CIH; try apply H.
+    inv Ht2; ddestruction; subst; try contra_size; try contradiction;  eauto.
+    step. auto.
+  -  unpriv_halt. inv SIZECHECK1. inv SIZECHECK2. eapply CIH; try apply H.
     Unshelve. all : auto.
-    inv Ht2; ddestruction; subst; try contra_size; try contradiction; pclearbot; eauto.
-    + pfold. apply H2.
+    inv Ht2; ddestruction; subst; try contra_size; try contradiction;  eauto.
+    + step. apply H2.
     + apply H1.
   - inv SIZECHECK.  eapply H0; eauto. Unshelve. all : auto.
-    inv Ht2; ddestruction; subst; try contra_size; try contradiction; pclearbot; eauto.
-    rewrite itree_eta' at 1. pstep_reverse.
-  - unpriv_halt. right. eapply CIH; eauto. pfold. apply Ht2.
-    pfold. apply H.
-  - pclearbot. unpriv_halt. right. eapply CIH; eauto. pfold. auto.
+    inv Ht2; ddestruction; subst; try contra_size; try contradiction;  eauto.
+    rewrite itree_eta' at 1. now unstep.
+  - unpriv_halt. eapply CIH; eauto. step. apply Ht2.
+    step. apply H.
+  -  unpriv_halt. eapply CIH; eauto. step. auto.
   - unpriv_halt. contra_size.
-  - unpriv_halt. right. pclearbot. eapply CIH with (t2 := Vis e1 k1); eauto.
-    + pfold. auto.
+  - unpriv_halt. eapply CIH with (t2 := Vis e1 k1); eauto.
+    + step. auto.
     + apply H.
   - unpriv_halt. contra_size.
 Qed.
 
-Lemma eqit_secure_RR_imp : forall E b1 b2 R1 R2 (RR1 RR2 : R1 -> R2 -> Prop) Label priv l
+Lemma eqit_secure_RR_imp : forall E (b1 b2 : bool) R1 R2 (RR1 RR2 : R1 -> R2 -> Prop) Label priv l
                 (t1 : itree E R1) (t2 : itree E R2),
-    RR1 <2= RR2 ->
+    (forall x y, RR1 x y -> RR2 x y) ->
     eqit_secure Label priv RR1 b1 b2 l t1 t2 ->
     eqit_secure Label priv RR2 b1 b2 l t1 t2.
 Proof.
   intros. generalize dependent t2. revert t1.
-  pcofix CIH. intros t1 t2 Ht12. pfold. red.
-  punfold Ht12. red in Ht12.
-  hinduction Ht12 before r; intros; eauto;
-  try (pclearbot; constructor; auto; right; eapply CIH; eauto; fail);
-  try (pclearbot; unpriv_co; right; eapply CIH; eauto; apply H0; fail).
-  pclearbot. constructor; auto. right. eapply CIH; eauto. apply H0.
-  - pclearbot. unpriv_halt. right. eapply CIH; eauto. apply H0.
-  - pclearbot. unpriv_halt. right. eapply CIH; eauto. apply H0.
+  icoinduction c CIH. intros t1 t2 Ht12.
+  step in Ht12. cbn in *.
+  hinduction Ht12 before c; intros; eauto;
+  try ( constructor; auto; intros; eapply CIH; eauto; fail);
+  try ( unpriv_co; intros; eapply CIH; eauto; apply H0; fail).
+   constructor; auto. intros. eapply CIH; eauto. apply H0.
+  -  unpriv_halt. eapply CIH; eauto. apply H0.
+  -  unpriv_halt. eapply CIH; eauto. apply H0.
 Qed.
 
 Lemma secret_halt_trans_3 :  forall E Label priv l b1 b2 (R1 R2 R3 A : Type) (RR1 : R1 -> R2 -> Prop)
@@ -605,7 +742,7 @@ Proof.
   intros. apply eqit_secure_sym in H1. apply eqit_secure_sym in H2.
   apply eqit_secure_sym. eapply secret_halt_trans_2 in H1; eauto.
   eapply eqit_secure_RR_imp; eauto.
-  intros. inv PR. econstructor; eauto.
+  intros. inv H3. econstructor; eauto.
 Qed.
 
 Lemma eqit_secure_trans : forall E Label priv l b1 b2 (R1 R2 R3 : Type) (RR1 : R1 -> R2 -> Prop)
@@ -615,235 +752,235 @@ Lemma eqit_secure_trans : forall E Label priv l b1 b2 (R1 R2 R3 : Type) (RR1 : R
     eqit_secure Label priv (rcompose RR1 RR2) b1 b2 l t1 t3.
 Proof.
   intros E Label priv l b1 b2 R1 R2 R3 RR1 RR2.
-  pcofix CIH0. intros t1 t2 t3 Ht12 Ht23.
-  punfold Ht12. red in Ht12. punfold Ht23. red in Ht23. pfold. red.
-  hinduction Ht12 before r; intros; try inv CHECK; auto with itree.
+  icoinduction c CIH0. intros t1 t2 t3 Ht12 Ht23.
+  step in Ht12. step in Ht23. 
+  hinduction Ht12 before E; intros; auto with itree.
   - remember (RetF r2) as x.
-    hinduction Ht23 before r; intros; inv Heqx; try inv CHECK; eauto with itree.
+    hinduction Ht23 before E; intros; inv Heqx; eauto with itree.
     rewrite itree_eta' at 1. unpriv_ind. eapply H0; eauto.
-  - pclearbot. genobs t4 ot4.
+  -  genobs t4 ot4.
     assert ( (exists t5, ot4 = TauF t5) \/ (forall t5, ot4 <> TauF t5) ).
     { destruct ot4; eauto; right; intros; discriminate. }
     destruct H0 as [ [t5 Ht4] | Ht4].
     + subst. rewrite Ht4. rewrite Ht4 in Ht23. constructor.
-      right. eapply CIH0; eauto. eapply eqit_secure_TauLR. pfold.
+      eapply CIH0; eauto. eapply eqit_secure_TauLR. step.
       auto.
     + destruct ot4; try (exfalso; eapply Ht4;  eauto; fail  ).
       * inv Ht23. inv CHECK. rewrite itree_eta' at 1.
-        assert (eqit_secure Label priv (rcompose RR1 RR2) true b2 l (Tau t0) (Ret r0)  ).
-        { pfold. red. cbn. rewrite itree_eta' at 1. eapply eqit_secure_trans_aux1; eauto.
-          pfold. red. constructor; auto. pstep_reverse. }
-        rewrite itree_eta'. pstep_reverse. eapply paco2_mon; eauto.
-        intros; contradiction.
+        assert (eqit_secure Label priv (rcompose RR1 RR2) true b2 l (Tau t0) (Ret r)  ).
+        { step. cbn. rewrite itree_eta' at 1. eapply eqit_secure_trans_aux1; eauto.
+          step. constructor; auto. now unstep. }
+        rewrite itree_eta'. 
+        now step. 
       * destruct (classic (leq (priv _ e) l ) ).
-        -- inv Ht23; ddestruction; subst; try contradiction; try inv CHECK.
-           constructor; auto. eapply eqit_secure_trans_aux2; eauto.
+        -- inv Ht23; ddestruction; subst; try contradiction.
+           constructor; auto. inv CHECK. 
+           eapply eqit_secure_trans_aux2; eauto.
         -- destruct (classic_empty X).
            ++ rewrite itree_eta'. rewrite itree_eta' at 1.
-              pstep_reverse.
-              eapply paco2_mon with (r := bot2); intros; try contradiction.
+              step. 
               eapply secret_halt_trans_3 with (t2 := Tau t3); eauto.
-              ** pfold. constructor. left. auto.
-              ** pfold. auto.
-           ++ unpriv_co. right. eapply CIH0; eauto.
+              ** now step; constructor.
+              ** now step.
+           ++ unpriv_co. eapply CIH0; eauto.
               assert (eqit_secure Label priv RR2 b1 b2 l (Tau t3) (Vis e k)).
-              pfold. auto. eapply eqit_secure_TauLVisR; eauto.
+              step. auto. eapply eqit_secure_TauLVisR; eauto.
   - apply IHHt12; auto.
     remember (TauF t0) as y.
-    hinduction Ht23 before r; intros; inv Heqy; try inv CHECK; eauto with itree.
-    + pclearbot. constructor; auto. pstep_reverse.
-    + pclearbot. unpriv_ind. pstep_reverse.
-    + pclearbot. punfold H.
-  - pclearbot. remember (VisF e k2) as x.
-    hinduction Ht23 before r; intros; inv Heqx; try inv CHECK; ddestruction; subst;
+    hinduction Ht23 before E; intros; inv Heqy; eauto with itree.
+    +  constructor; auto. now unstep. 
+    +  unpriv_ind. now unstep. 
+    +  now step in H.
+  -  remember (VisF e k2) as x.
+    hinduction Ht23 before E; intros; inv Heqx; ddestruction; subst;
     try contradiction; eauto with itree.
-    + pclearbot. constructor; auto. intros. right. eapply CIH0; eauto; try apply H0.
+    +  constructor; auto. intros. eapply CIH0; eauto; try apply H0.
       apply H.
     + rewrite itree_eta' at 1. unpriv_ind. eapply H0; eauto.
-  - pclearbot. remember (TauF t0) as x.
-    hinduction Ht23 before r; intros; inv Heqx; try inv CHECK; auto.
-    + pclearbot. unpriv_co. right. eapply CIH0; try apply H0.
+  -  remember (TauF t0) as x.
+    hinduction Ht23 before E; intros; inv Heqx; auto.
+    +  unpriv_co. eapply CIH0; try apply H0.
       auto.
     + destruct ot2.
       * clear IHHt23. rewrite itree_eta'. unpriv_ind.
         remember (k1 a) as t. specialize (H a). setoid_rewrite <- Heqt in H.
-        clear Heqt a k1. cbn. eapply eqit_secure_trans_aux1; eauto.
-      * unpriv_co. right. eapply CIH0; try apply H.
+        clear Heqt a k1. cbn. inv CHECK. eapply eqit_secure_trans_aux1; eauto.
+      * unpriv_co. eapply CIH0; try apply H.
         clear IHHt23. remember (TauF t) as y.
-        pfold. red.
-        hinduction Ht23 before r; intros; inv Heqy; try inv CHECK; eauto with itree.
-        -- pclearbot. constructor; auto. pstep_reverse.
-        -- pclearbot. unpriv_ind. pstep_reverse.
-        -- pclearbot. punfold H.
+        step.
+        hinduction Ht23 before E; intros; inv Heqy; eauto with itree.
+        --  constructor; auto. now unstep. 
+        --  unpriv_ind. now unstep. 
+        -- now step in H.
       * destruct (classic (leq (priv _ e0) l ) ).
         -- rewrite itree_eta'. unpriv_ind. cbn.
            clear IHHt23. remember (k1 a) as t. specialize (H a). setoid_rewrite <- Heqt in H.
-           clear Heqt a k1. eapply eqit_secure_trans_aux2; eauto.
+           clear Heqt a k1. inv CHECK. eapply eqit_secure_trans_aux2; eauto.
         -- destruct (classic_empty X).
-           ++ rewrite itree_eta'. unpriv_ind.
-              pstep_reverse. apply paco2_mon with (r := bot2); intros; try contradiction.
+           ++ rewrite itree_eta'. unpriv_ind. step. 
               eapply secret_halt_trans_3; eauto. apply H.
-              pfold. auto.
-           ++ unpriv_co. right. eapply CIH0. apply H.
-              clear IHHt23. pstep. red. remember (VisF e0 k) as y.
-              hinduction Ht23 before r; intros; inv Heqy; try inv CHECK;
+              now step. 
+           ++ unpriv_co. eapply CIH0. apply H.
+              clear IHHt23. step. remember (VisF e0 k) as y.
+              hinduction Ht23 before E; intros; inv Heqy;
                 ddestruction; subst; try contradiction; try contra_size; eauto with itree.
-              ** pclearbot. constructor; auto. pstep_reverse.
-              ** unpriv_ind. pclearbot. pstep_reverse.
-              ** pclearbot. rewrite itree_eta' at 1. pstep_reverse.
+              **  constructor; auto. now unstep. 
+              ** unpriv_ind.  now unstep. 
+              **  rewrite itree_eta' at 1. now unstep. 
     + constructor; auto. eapply IHHt23; eauto.
-    + pclearbot. unpriv_co. right. eapply CIH0; try apply H0. apply H.
+    +  unpriv_co. eapply CIH0; try apply H0. apply H.
     + rewrite itree_eta' at 1. unpriv_ind. eapply H0; eauto.
-    + unpriv_halt. right. pclearbot. eapply CIH0; eauto. apply H0.
-  - pclearbot.
+    + unpriv_halt.  eapply CIH0; eauto. apply H0.
+  - 
     genobs_clear t3 ot3.
     assert (Hne : nonempty A); eauto. inv Hne.
     assert ( (exists t4, ot3 = TauF t4) \/ (forall t4, ot3 <> TauF t4) ).
     { destruct ot3; eauto; right; intros; discriminate. }
     destruct H0 as [ [t4 Ht3] | Ht3].
-    + subst. constructor. right. eapply CIH0; try apply H.
+    + subst. constructor. eapply CIH0; try apply H.
       Unshelve. all: auto.
-      eapply eqit_secure_TauRVisL; eauto. pfold. auto.
-       (* should be fine but new lemma, also shelved goal *)
+      eapply eqit_secure_TauRVisL; eauto. step. auto.
     +
       destruct ot3; try (exfalso; eapply Ht4;  eauto; fail  ).
-      * inv Ht23; inv CHECK. ddestruction. subst. clear CIH0.
-        constructor; auto. rewrite H4. eapply eqit_secure_trans_aux1; eauto.
-        rewrite <- H4. apply H1. Unshelve. auto. (* shelved goal*)
-      * constructor. right. eapply CIH0; try apply H.
-        eapply eqit_secure_TauRVisL; eauto. pfold. auto.
-        (* same goal as last admit *)
+      * inv Ht23; inv CHECK. ddestruction. clear CIH0.
+        constructor; auto. rewrite H4. eapply eqit_secure_trans_aux1; try apply H.
+        rewrite <- H4. apply H1. Unshelve. auto.
+      * constructor. eapply CIH0; try apply H.
+        eapply eqit_secure_TauRVisL; eauto. step. auto.
       * destruct (classic (leq (priv _ e0) l ) ).
-        -- inv Ht23; try inv CHECK; ddestruction; subst; try contradiction.
-           constructor; auto. rewrite H5. eapply eqit_secure_trans_aux2; eauto.
+        -- inv Ht23; ddestruction; subst; try contradiction.
+           constructor; auto. rewrite H5. inv CHECK. 
+           eapply eqit_secure_trans_aux2; intros; try apply H; eauto.
            rewrite <- H5. apply H2. Unshelve. all : auto.
         -- destruct (classic_empty X).
-           ++ rewrite itree_eta'. rewrite itree_eta' at 1. pstep_reverse.
-              eapply paco2_mon with (r := bot2); intros; try contradiction.
+           ++ rewrite itree_eta'. rewrite itree_eta' at 1. step. 
               eapply secret_halt_trans_3 with (t2 := Vis e k2); eauto.
-              ** pfold. red. cbn. unpriv_co.
-              ** pfold. auto.
-           ++ unpriv_co. right. eapply CIH0; try apply H.
+              ** step. cbn. unpriv_co.
+              ** now step. 
+           ++ unpriv_co. eapply CIH0; try apply H.
               Unshelve. all : auto.
               assert (eqit_secure Label priv RR2 b1 b2 l (Vis e k2) (Vis e0 k) ).
-              pfold. auto. eapply eqit_secure_VisLR; eauto.
-  - pclearbot. remember (VisF e2 k2) as x.
-    (* maybe need to separate the inductive and coinductive progress cases? *)
-    hinduction Ht23 before r; intros; inv Heqx; try inv CHECK; try contradiction;
+              step. auto. eapply eqit_secure_VisLR; eauto.
+  -  remember (VisF e2 k2) as x.
+    hinduction Ht23 before E; intros; inv Heqx; try contradiction;
     try contra_size;
     ddestruction; subst; auto.
     + constructor; auto. eapply IHHt23; eauto.
-    + pclearbot. unpriv_co. right. eapply CIH0; try apply H0. apply H.
-    + pclearbot. assert (Hne : nonempty B); eauto. inv Hne.
-      unpriv_co. right. eapply CIH0; eauto; try eapply H0. apply H.
+    +  unpriv_co. eapply CIH0; try apply H0. apply H.
+    +  assert (Hne : nonempty B); eauto. inv Hne.
+      unpriv_co. eapply CIH0; eauto; try eapply H0. apply H.
       Unshelve. auto.
-    + pclearbot. assert (Hne : nonempty B0); eauto. inv Hne.
-      unpriv_co. right. eapply CIH0; try apply H0. apply H.
+    +  assert (Hne : nonempty B0); eauto. inv Hne.
+      unpriv_co. eapply CIH0; try apply H0. apply H.
       Unshelve. auto.
     + genobs t2 ot2. destruct ot2.
       * assert (Hne : nonempty B); eauto. inv Hne.
-        rewrite itree_eta'. unpriv_ind. eapply eqit_secure_trans_aux1; eauto.
+        rewrite itree_eta'. unpriv_ind. inv CHECK. 
+        eapply eqit_secure_trans_aux1; try apply H1; eauto.
         Unshelve. auto.
       * assert (Hne : nonempty B); eauto. inv Hne.
-        unpriv_co. right. eapply CIH0; try apply H1. Unshelve. all : auto.
-        clear H0. specialize (H a). pfold. red. genobs (k2 a) ok2.
+        unpriv_co. eapply CIH0; try apply H1. Unshelve. all : auto.
+        clear H0. specialize (H a). step. genobs (k2 a) ok2.
         clear Heqok2 H1 k2.
         remember (TauF t) as y.
-        hinduction H before r; intros; inv Heqy; try inv CHECK; auto.
-        -- constructor; auto. pclearbot. pstep_reverse.
-        -- constructor; eauto.
-        -- pclearbot. unpriv_ind. pstep_reverse.
-        -- unpriv_ind. eapply H0; eauto.
-        -- pclearbot. rewrite itree_eta' at 1. pstep_reverse.
+        hinduction H before E; intros; inv Heqy; auto.
+        -- constructor; auto.  now unstep. 
+        -- apply secEqTauL; eauto. 
+        -- unpriv_ind. now unstep. 
+        -- unpriv_ind. eapply H0 with (c:=c); eauto. 
+        --  rewrite itree_eta' at 1. now unstep. 
       * inv SIZECHECK2.
         destruct (classic (leq (priv _ e) l ) ).
-        -- rewrite itree_eta'. unpriv_ind.
-           eapply eqit_secure_trans_aux2; eauto. Unshelve. all : auto.
+        -- rewrite itree_eta'. unpriv_ind. inv CHECK. 
+           eapply eqit_secure_trans_aux2; try apply H1; eauto. Unshelve. all : auto.
         -- destruct (classic_empty X).
-           ++ unpriv_halt. right. eapply CIH0; eauto. apply H1.
-              pfold. apply H. Unshelve. auto.
-           ++ unpriv_co. right. eapply CIH0; try apply H1.
+           ++ unpriv_halt. eapply CIH0; eauto. apply H1.
+              step. apply H. Unshelve. auto.
+           ++ unpriv_co. eapply CIH0; try apply H1.
               Unshelve. all : auto.
-              clear H0. pstep. red. remember (VisF e k) as y.
+              clear H0. step. remember (VisF e k) as y.
               specialize (H a). clear Heqot2. genobs (k2 a) ok2.
               clear Heqok2.
-              hinduction H before r; intros; inv Heqy; try inv CHECK;
-                ddestruction; subst; try contradiction; try contra_size; eauto with itree.
-              ** pclearbot. constructor; auto. pstep_reverse.
-              ** unpriv_ind. pclearbot. pstep_reverse.
-              ** pclearbot. rewrite itree_eta' at 1. pstep_reverse.
+              hinduction H before E; intros; inv Heqy;
+                ddestruction; subst; try contradiction; try contra_size.
+              **  constructor; auto. 
+                  eapply IHsecure_eqitF. 
+                  13: exact H1. all: eauto.
+              **  constructor; auto. now unstep.
+              ** unpriv_ind.  now unstep.
+              ** apply EqVisUnPrivLInd; auto. 
+                  intro. eapply H0. 
+                  13: exact H1. all: eauto. 
+              ** eauto with itree.   
+              **  rewrite itree_eta' at 1. now unstep.
     + rewrite itree_eta' at 1. unpriv_ind. eapply H0; eauto.
-    + pclearbot. inv SIZECHECK2. unpriv_halt. right. eapply CIH0; eauto. apply H0.
+    +  inv SIZECHECK2. unpriv_halt. eapply CIH0; eauto. apply H0.
       apply H. Unshelve. auto.
-  - remember (VisF e k2) as x. hinduction Ht23 before r; intros; inv Heqx; try inv CHECK;
+  - remember (VisF e k2) as x. hinduction Ht23 before E; intros; inv Heqx;
     ddestruction; subst; try contradiction; try contra_size;  auto.
     + constructor; auto. eapply IHHt23; eauto.
-    + constructor; auto. pclearbot. assert (Hne : nonempty A0); eauto. inv Hne. eapply H0; eauto.
-      pstep_reverse. Unshelve. auto.
-    + unpriv_ind. assert (Hne : nonempty A0); eauto. inv Hne. eapply H0; eauto.
-      pclearbot. pstep_reverse. Unshelve. auto.
+    + constructor; auto.  assert (Hne : nonempty A0); eauto. inv Hne. eapply H1; eauto.
+      now unstep. Unshelve. auto.
+    + unpriv_ind. assert (Hne : nonempty A0); eauto. inv Hne. eapply H1; eauto.
+       now unstep. Unshelve. auto.
     + assert (Hne : nonempty A0). { eauto. } inv Hne. eauto. Unshelve.  auto.
     + unpriv_ind. eauto.
-    + pclearbot. rewrite itree_eta'. pstep_reverse.
-      apply paco2_mon with (r := bot2); intros; try contradiction.
+    +  rewrite itree_eta'. step. 
       inv SIZECHECK0.
       eapply secret_halt_trans_3 with (t2 := k0 a); eauto.
-      * pfold. apply H1.
+      * step. apply H0.
       * apply H.
-  - pclearbot.
+  - 
     remember (TauF t0) as y.
-    hinduction Ht23 before r; intros; inv Heqy; subst; eauto with itree; pclearbot.
-    + unpriv_halt. right. eapply CIH0; eauto.
+    hinduction Ht23 before E; intros; inv Heqy; subst; eauto with itree. 
     + clear IHHt23. rewrite itree_eta'. rewrite itree_eta' at 1.
-      pstep_reverse. apply paco2_mon with (r := bot2); intros; try contradiction.
-      eapply secret_halt_trans_2; eauto. pfold. auto.
-    + unpriv_halt. right. eapply CIH0; eauto. apply H.
+      step. 
+      eapply secret_halt_trans_2; eauto. step. auto.
+    + unpriv_halt. eapply CIH0; eauto. apply H.
     + rewrite itree_eta' at 1. unpriv_ind. eapply H0; eauto.
     + unpriv_halt. contra_size.
-  - pclearbot.
-    inv Ht23; ddestruction; subst; try contra_size; try contradiction;
-    try inv CHECK.
-    + constructor. right. eapply CIH0; eauto. pfold. auto.
-    + unpriv_co. right. eapply CIH0; eauto. rewrite H0 in H2.
-      pfold. apply H2.
-    + pclearbot. constructor. right. eapply CIH0; eauto.
-    + pclearbot. destruct (classic_empty B).
-      * unpriv_halt. right. eapply CIH0; eauto. pfold. red. cbn. unpriv_halt.
-      * unpriv_co. right. eapply CIH0; eauto. apply H1.
-    + pclearbot. unpriv_halt. right. eapply CIH0; eauto.
-      pfold. red. cbn. unpriv_halt. contra_size.
- - pclearbot. rewrite itree_eta' at 1. pstep_reverse.
-   apply paco2_mon with (r := bot2); intros; try contradiction.
+  - 
+    inv Ht23; ddestruction; subst; try contra_size; try contradiction.
+    + constructor. eapply CIH0; eauto. step. auto.
+    + unpriv_co. eapply CIH0; eauto. rewrite H0 in H2.
+      step. apply H2.
+    +  constructor. eapply CIH0; eauto.
+    +  destruct (classic_empty B).
+      * unpriv_halt. eapply CIH0; eauto. step. cbn. unpriv_halt.
+      * unpriv_co. eapply CIH0; eauto. apply H1.
+    +  unpriv_halt. eapply CIH0; eauto.
+      step. cbn. unpriv_halt. contra_size.
+ -  rewrite itree_eta' at 1. step.
    eapply secret_halt_trans_2 with (t2 := Vis e2 k2); eauto.
-   + pfold. red. cbn. unpriv_halt.
-   + pfold. auto.
- - pclearbot. destruct (classic_empty A).
-   + inv Ht23; ddestruction; subst; try contradiction; try contra_size; try inv CHECK.
-     * unpriv_halt. right. eapply CIH0 with (t2 := Vis e2 k2); eauto.
-       -- pfold. red. cbn. unpriv_halt. contra_size.
-       -- pfold. auto.
-     * unpriv_halt. right. rewrite H1 in H3. eapply CIH0 with (t2 := Vis e2 k2); eauto.
-       -- pfold. red. cbn. unpriv_halt. contra_size.
-       -- pfold. apply H3.
-     * unpriv_halt. pclearbot. right. eapply CIH0; eauto.
-       pfold. red. cbn. unpriv_halt. contra_size.
-     * unpriv_halt. pclearbot. right. eapply CIH0 with (t2 := Vis e2 k2); eauto.
-       -- pfold. red. cbn. unpriv_halt. contra_size.
+   + step. cbn. unpriv_halt.
+   + step. auto.
+ -  destruct (classic_empty A).
+   + inv Ht23; ddestruction; subst; try contradiction; try contra_size.
+     * unpriv_halt. eapply CIH0 with (t2 := Vis e2 k2); eauto.
+       -- step. cbn. unpriv_halt. contra_size.
+       -- step. auto.
+     * unpriv_halt. rewrite H1 in H3. eapply CIH0 with (t2 := Vis e2 k2); eauto.
+       -- step. cbn. unpriv_halt. contra_size.
+       -- step. apply H3.
+     * unpriv_halt.  eapply CIH0; eauto.
+       step. cbn. unpriv_halt. contra_size.
+     * unpriv_halt.  eapply CIH0 with (t2 := Vis e2 k2); eauto.
+       -- step. cbn. unpriv_halt. contra_size.
        -- apply H2.
      * unpriv_halt. contra_size.
    + destruct (observe t3).
      * inv Ht23; ddestruction; subst; try contra_size; try contradiction.
-     * unpriv_co. right. eapply CIH0; eauto. apply H.
+     * unpriv_co. eapply CIH0; eauto. apply H.
        inv Ht23; ddestruction; subst; try contra_size; try contradiction.
-       pfold. auto. pclearbot. auto.
+       step. auto.  auto.
      * destruct (classic (leq (priv _ e) l ) ).
        { inv Ht23; ddestruction; subst; try contra_size; try contradiction. }
        destruct (classic_empty X).
-       -- unpriv_halt. right. eapply CIH0; eauto. apply H. pfold. auto.
-       -- unpriv_co. right. eapply CIH0; eauto. apply H.
+       -- unpriv_halt. eapply CIH0; eauto. apply H. step. auto.
+       -- unpriv_co. eapply CIH0; eauto. apply H.
           inv Ht23; ddestruction; subst; try contra_size; try contradiction.
-          ++ pfold. apply H5.
-          ++ pclearbot. apply H4.
+          ++ step. apply H5.
+          ++  apply H4.
 Qed.
 
 
@@ -851,33 +988,32 @@ Lemma eqit_itree_eqit_secure : forall E Label priv l R1 R2 RR (t1 t1': itree E R
     t1 ≅ t1' -> eqit_secure Label priv RR false false l t1 t2 ->
     eqit_secure Label priv RR false false l t1' t2.
 Proof.
-  intros E Label priv l R1 R2 RR. pcofix CIH.
-  intros t1 t1' t2 Heq Hsec. pstep. red.
-  punfold Heq. red in Heq. punfold Hsec. red in Hsec.
-  inv Heq; try inv CHECK.
-  - rewrite <- H0 in Hsec. rewrite itree_eta' at 1. pstep_reverse.
-    eapply paco2_mon with (r := bot2); intros; try contradiction. pfold.
-    red. cbn. remember (RetF r2) as x. clear H H0.
-    hinduction Hsec before r; intros; inv Heqx; eauto with itree.
-  - pclearbot. genobs t2 ot2.
+  intros E Label priv l R1 R2 RR. coinduction c CIH.
+  intros t1 t1' t2 Heq Hsec. icbn. 
+  step in Heq. step in Hsec. 
+  inv Heq.
+  - rewrite <- H0 in Hsec. rewrite itree_eta' at 1. 
+    remember (RetF r2) as x. clear H H0.
+    hinduction Hsec before E; intros; inv Heqx; eauto with itree.
+  -  genobs t2 ot2.
     assert ( (exists t3, ot2 = TauF t3) \/ (forall t3, ot2 <> TauF t3) ).
     { destruct ot2; eauto; right; intros; discriminate. }
     destruct H1 as [ [t3 Ht2] | Ht2].
     + subst. rewrite Ht2. rewrite Ht2 in Hsec. constructor.
-      right. eapply CIH; eauto. rewrite <- H0 in Hsec. inv Hsec; try inv CHECK. pclearbot. auto.
+      eapply CIH; eauto. rewrite <- H0 in Hsec. inv Hsec.
     + destruct ot2; try (exfalso; eapply Ht2;  eauto; fail  ).
-      * rewrite <- H0 in Hsec. inv Hsec; try inv CHECK.
-      * rewrite <- H0 in Hsec. inv Hsec; ddestruction; subst; try inv CHECK.
-        -- pclearbot. unpriv_co. right. eapply CIH; eauto. apply H3.
-        -- pclearbot. unpriv_halt. right. eapply CIH; eauto.
-  - rewrite <- H0 in Hsec. inv Hsec; ddestruction; subst; try inv CHECK; try contradiction; try contra_size.
-    + pclearbot. constructor; auto. right. eapply CIH; eauto with itree. apply H2.
-    + pclearbot. unpriv_co. right. eapply CIH; eauto with itree. apply H2.
-    + pclearbot. unpriv_co. right. eapply CIH; eauto with itree. apply H2.
-    + pclearbot. unpriv_halt. right. eapply CIH; eauto. pfold. constructor. left. auto.
-    + pclearbot. unpriv_halt. right. eapply CIH with (t1 := Vis e k1); try apply H2.
-      pfold. constructor. left. auto.
-    + pclearbot. unpriv_halt. right. eapply CIH; eauto with itree. apply H2.
+      * rewrite <- H0 in Hsec. inv Hsec.
+      * rewrite <- H0 in Hsec. inv Hsec; ddestruction; subst.
+        --  unpriv_co. eapply CIH; eauto. apply H3.
+        --  unpriv_halt. eapply CIH; eauto.
+  - rewrite <- H0 in Hsec. inv Hsec; ddestruction; subst; try contradiction; try contra_size.
+    +  constructor; auto. intros. eapply CIH; try apply REL. apply H2.
+    +  unpriv_co. eapply CIH; try apply REL. apply H2.
+    +  unpriv_co. eapply CIH; try apply REL. apply H2.
+    +  unpriv_halt. eapply CIH; try apply H2. step. constructor. auto.
+    +  unpriv_halt. eapply CIH with (t1 := Vis e k1); try apply H2.
+      step. constructor. auto.
+    +  unpriv_halt. eapply CIH; try apply REL. eauto with itree. apply H2.
 Qed.
 
 Lemma eqit_secure_eq_trans : forall E R b1 b2 Label priv l (t1 t2 t3 : itree E R),
@@ -886,7 +1022,7 @@ Lemma eqit_secure_eq_trans : forall E R b1 b2 Label priv l (t1 t2 t3 : itree E R
     eqit_secure Label priv eq b1 b2 l t1 t3.
 Proof.
   intros. apply eqit_secure_RR_imp with (RR1 := rcompose eq eq).
-  { intros. inv PR. auto. }
+  { intros. inv H1. }
   eapply eqit_secure_trans; eauto.
 Qed.
 
@@ -931,20 +1067,55 @@ Global Instance proper_eqit_secure_eqit_secure
 Proof.
   repeat intro; split; intros.
   - eapply eqit_secure_RR_imp with (RR1 := rcompose RR eq); eauto.
-    { intros. inv PR. auto. }
+    { intros. inv H2. }
     eapply eqit_secure_trans; eauto.
     apply eqit_secure_sym.
-    eapply eqit_secure_RR_imp with (RR1 := rcompose (flip RR) eq); eauto.
-    { intros. inv PR. auto. }
+    eapply eqit_secure_RR_imp with (RR1 := rcompose (Basics.flip RR) eq); eauto.
+    { intros. inv H2. }
     eapply eqit_secure_trans; eauto. apply eqit_secure_sym. auto.
   - assert (eqit_secure Label priv eq b b l y0 x0).
     { apply eqit_secure_sym. eapply eqit_secure_RR_imp; eauto. }
     eapply eqit_secure_RR_imp with (RR1 := rcompose RR eq).
-    { intros. inv PR. auto. }
+    { intros. inv H3. }
     eapply eqit_secure_trans; eauto.
     assert (eqit_secure Label priv eq b b l y x).
     { apply eqit_secure_sym. eapply eqit_secure_RR_imp; eauto. }
     eapply eqit_secure_RR_imp with (RR1 := rcompose eq RR).
-    { intros. inv PR. auto. }
+    { intros. inv H4. }
     eapply eqit_secure_trans; eauto.
 Qed.
+
+
+
+
+(* Lemma tau_secure_eqit_mon : forall E R1 R2 Label priv l RR (t1 : itree E R1) (t2 : itree E R2)
+    (c : Chain (secure_eqit_mon Label priv RR true true l)), 
+    secure_eqit_mon Label priv RR true true l (elem c) (Tau t1) t2 -> secure_eqit_mon Label priv RR true true l (elem c) t1 t2.
+Proof.
+  intros E R1 R2 Label priv l RR.  intros t1 t2 c Hsec.
+  icbn; icbn in Hsec; cbn in *. remember (TauF t1) as x.
+  hinduction Hsec before priv; intros; inversion Heqx; subst; eauto with itree.
+  - constructor; auto. now unstep. 
+  - unpriv_ind. now unstep. 
+  - now step in H.
+Qed. *)
+
+
+(* #[global] Instance eutt_secure_secure_eqit_mon {E : Type -> Type} {R1 R2 : Type} {RR : R1 -> R2 -> Prop} {Label priv l} 
+    (c : Chain (secure_eqit_mon Label priv RR true true l)): 
+    Proper (@eq_itree E _ _ eq ==> eq ==> Basics.flip Basics.impl)
+     (elem c).
+Proof.
+  do 5 red. tower induction; subst. 
+  clear c. intros c. intros CIH t1 t1' Heutt t2 _ <- Hsec. 
+  step in Heutt. icbn; icbn in Hsec.  
+  hinduction Heutt before E; intros; subst; auto with itree.
+  (* - remember (RetF r2) as x. hinduction Hsec before E; intros; try inv Heqx; auto with itree.
+    + constructor; auto. eapply IHHsec; eauto.
+    + unpriv_ind. eapply H0; eauto. *)
+  - genobs t2 ot2. clear Heqot2. 
+    assert (Ht2 : (exists m3, ot2 = TauF m3) \/ (forall m3, ot2 <> TauF m3) ).
+    { destruct ot2; eauto; right; repeat intro; discriminate. }
+    (* because of the extra inductive cases this is not enough *)
+    destruct Ht2 as [ [m3 Hm3] | Ht2 ].
+    + subst.  constructor. eapply CIH; eauto. *)
diff --git a/extra/Secure/SecureEqEuttTrans.v b/extra/Secure/SecureEqEuttTrans.v
index 438d904c..10983023 100644
--- a/extra/Secure/SecureEqEuttTrans.v
+++ b/extra/Secure/SecureEqEuttTrans.v
@@ -1,15 +1,14 @@
+From Coinduction Require Import all. 
 From ITree Require Import
      Axioms
      ITree
-     ITreeFacts.
+     ITreeFacts. 
 
 From ITree.Extra Require Import
      Secure.SecureEqHalt
      Secure.SecureEqEuttHalt
 .
 
-From Paco Require Import paco.
-
 Import Monads.
 Import MonadNotation.
 Local Open Scope monad_scope.
@@ -20,23 +19,23 @@ Lemma eses_aux3:
     (priv : forall A : Type, E A -> L) (l : L) (R2 : Type) (RR1 : R1 -> R2 -> Prop)
     (RR2 : R2 -> R3 -> Prop) (r : itree E R1 -> itree E R3 -> Prop)
     (m1 : itree E R2) (m2 : itree E R3),
-    paco2 (eqit_ RR2 true true id) bot2 m1 m2 ->
+    eutt RR2 m1 m2 ->
     forall r0 : R1,
-      secure_eqitF Label priv RR1 true true l id
-                   (upaco2 (secure_eqit_ Label priv RR1 true true l id) bot2) (RetF r0)
+      secure_eqitF Label priv RR1 true true l
+                   (eqit_secure Label priv RR1 true true l) (RetF r0)
                    (observe m1) ->
-      secure_eqitF Label priv (rcompose RR1 RR2) true true l id
-                   (upaco2 (secure_eqit_ Label priv (rcompose RR1 RR2) true true l id) r)
+      secure_eqitF Label priv (rcompose RR1 RR2) true true l
+                   r
                    (RetF r0) (observe m2).
 Proof.
   intros E R3 R1 Label priv l R2 RR1 RR2 r m1 m2 REL r0 Hsec.
   remember (RetF r0) as x.
-  punfold REL. red in REL. hinduction Hsec before r; intros; inv Heqx; eauto.
+  step in REL. hinduction Hsec before r; intros; inv Heqx; eauto.
   - remember (RetF r2) as y. hinduction REL before r; intros; inv Heqy; eauto with itree.
-  - eapply IHHsec; eauto. pstep_reverse. setoid_rewrite <- tau_eutt at 1. pfold. auto.
+  - eapply IHHsec; eauto. unstep. setoid_rewrite <- tau_eutt at 1. step. auto.
   - remember (VisF e k2) as y.
     hinduction REL before r; intros; inv Heqy; ddestruction; subst; eauto with itree.
-    pclearbot. unpriv_ind. eapply H0; eauto. pstep_reverse.
+     unpriv_ind. eapply H0; eauto. now unstep.
 Qed.
 
 
@@ -47,32 +46,30 @@ Lemma eses_aux4:
     (m1 : itree E R2) (m2 : itree E R3),
     (forall (t1 : itree E R1) (t2 : itree E R2) (t3 : itree E R3),
         eqit_secure Label priv RR1 true true l t1 t2 -> eutt RR2 t2 t3 -> r t1 t3) ->
-    paco2 (eqit_ RR2 true true id) bot2 m1 m2 ->
+    eutt RR2 m1 m2 ->
     forall (X : Type) (e : E X) (k : X -> itree E R1),
-      secure_eqitF Label priv RR1 true true l id
-                   (upaco2 (secure_eqit_ Label priv RR1 true true l id) bot2) (VisF e k)
+      secure_eqitF Label priv RR1 true true l
+                   (eqit_secure Label priv RR1 true true l) (VisF e k)
                    (observe m1) ->
       leq (priv X e) l ->
-      secure_eqitF Label priv (rcompose RR1 RR2) true true l id
-                   (upaco2 (secure_eqit_ Label priv (rcompose RR1 RR2) true true l id) r)
+      secure_eqitF Label priv (rcompose RR1 RR2) true true l
+                   r
                    (VisF e k) (observe m2).
 Proof.
   intros E R3 R1 Label priv l R2 RR1 RR2 r m1 m2 CIH REL X e k Hsec SECCHECK.
-  punfold REL. red in REL. remember (VisF e k) as y.
+  step in REL. remember (VisF e k) as y.
   hinduction Hsec before r; intros; inv Heqy; ddestruction; subst; try contradiction.
-  - eapply IHHsec; eauto. pstep_reverse. rewrite <- tau_eutt at 1. pfold. auto.
-  - pclearbot. inv REL; ddestruction; subst.
-    + constructor; auto. right. pclearbot. eapply CIH; eauto with itree.
-      apply H.
+  - eapply IHHsec; eauto. unstep. rewrite <- tau_eutt at 1. step. auto.
+  -  inv REL; ddestruction; subst.
+    + constructor; auto. intros. eapply CIH; eauto with itree.
     + constructor; auto. remember (VisF e0 k2) as y.
       hinduction REL0 before r; intros; inv Heqy; ddestruction; subst; try contradiction.
-      * constructor; auto. right. pclearbot. eapply CIH; eauto with itree. apply H.
+      * constructor; auto. intros. eapply CIH; eauto with itree.
       * constructor; auto. eapply IHREL0; eauto.
   - rewrite H2. remember (VisF e k2) as y.
     hinduction REL before r; intros; inv Heqy; ddestruction; subst; try contradiction.
     + rewrite itree_eta' at 1. unpriv_ind. rewrite <- H2. eapply H0; eauto.
-      pclearbot.
-      pstep_reverse.
+      now unstep.
     + constructor; auto. eapply IHREL; eauto.
 Qed.
 
@@ -82,10 +79,10 @@ Lemma eutt_secure_eqit_secure : forall E Label priv l R1 R2 R3 (RR1 : R1 -> R2 -
     eqit_secure Label priv RR1 true true l t1 t2 -> eutt RR2 t2 t3 ->
     eqit_secure Label priv (rcompose RR1 RR2) true true l t1 t3.
 Proof.
-  intros E Label priv l R1 R2 R3 RR1 RR2. pcofix CIH. intros t1 t2 t3 Hsec Heutt.
-  punfold Heutt. red in Heutt. punfold Hsec. red in Hsec.
-  pfold. red. hinduction Heutt before r; intros; subst; auto with itree.
-  - remember (RetF r2) as x. remember (RetF r1)  as y. hinduction Hsec before r; intros; try inv Heqx; try inv Heqy; subst; auto with itree.
+  intros E Label priv l R1 R2 R3 RR1 RR2. icoinduction c CIH. intros t1 t2 t3 Hsec Heutt.
+  step in Heutt. step in Hsec. cbn in *.
+  hinduction Heutt before c; intros; subst; auto with itree.
+  - remember (RetF r2) as x. remember (RetF r1)  as y. hinduction Hsec before c; intros; try inv Heqx; try inv Heqy; subst; auto with itree.
     + constructor; eauto with itree.
     + constructor; auto. eapply IHHsec; eauto.
     + rewrite itree_eta'. unpriv_ind. eapply H0; eauto.
@@ -94,61 +91,60 @@ Proof.
     { destruct ot1; eauto; right; repeat intro; discriminate. }
     (* because of the extra inductive cases this is not enough *)
     destruct Ht1 as [ [m3 Hm3] | Ht1 ].
-    + subst. pclearbot. constructor. right. eapply CIH; eauto.
+    + subst.  constructor. eapply CIH; eauto.
       apply tau_eqit_secure. apply eqit_secure_sym. apply tau_eqit_secure.
-      apply eqit_secure_sym. pfold. auto.
+      apply eqit_secure_sym. step. auto.
     + destruct ot1; try (exfalso; eapply Ht1; eauto; fail).
-      * pclearbot. rewrite itree_eta'. rewrite itree_eta' in Hsec.
-        eapply eses_aux3; eauto. pfold. constructor.
-        left. auto.
+      *  rewrite itree_eta'. rewrite itree_eta' in Hsec.
+        eapply eses_aux3; eauto. step. constructor. auto.
       * assert (leq (priv _ e) l \/ ~ leq (priv _ e) l).
         { apply classic. }
         destruct H as [SECCHECK | SECCHECK]; destruct ( classic_empty X  ).
-        ++ pclearbot. rewrite itree_eta'. rewrite itree_eta' in Hsec.
+        ++  rewrite itree_eta'. rewrite itree_eta' in Hsec.
            eapply eses_aux4; eauto. do 2 rewrite tau_eutt. auto.
-        ++ pclearbot. rewrite itree_eta'.
+        ++  rewrite itree_eta'.
            rewrite itree_eta' in Hsec. eapply eses_aux4; eauto.
            do 2 rewrite tau_eutt. auto.
-        ++ unpriv_halt. pclearbot. right. eapply CIH; eauto.
+        ++ unpriv_halt. eapply CIH; eauto.
            apply eqit_secure_sym. apply tau_eqit_secure. apply eqit_secure_sym.
-           pfold. auto.
-        ++ pclearbot.
-           unpriv_co. pclearbot. right. eapply CIH; try apply REL.
+           step. auto.
+        ++
+           unpriv_co. eapply CIH; try apply REL.
            apply eqit_secure_sym. apply tau_eqit_secure.
            apply eqit_secure_sym.
            eapply unpriv_e_eqit_secure; eauto.
-           pfold. auto.
-  - pclearbot. destruct (classic (leq (priv _ e) l ) ).
+           step. auto.
+  -  destruct (classic (leq (priv _ e) l ) ).
     + genobs_clear t1 ot1.
       remember (VisF e k1) as y.
-      hinduction Hsec before r; intros; try inv Heqy; ddestruction; subst; try contradiction;
+      hinduction Hsec before c; intros; try inv Heqy; ddestruction; subst; try contradiction;
       eauto with itree.
-      * constructor; auto. right. pclearbot. eapply CIH; eauto with itree. apply H.
+      * constructor; auto. intros. eapply CIH; eauto with itree. apply H.
       * rewrite itree_eta'. unpriv_ind. eapply H0; eauto.
     + remember (VisF e k1) as y.
-      hinduction Hsec before r; intros; inv Heqy; ddestruction; subst; try contradiction.
+      hinduction Hsec before c; intros; inv Heqy; ddestruction; subst; try contradiction.
       * eauto with itree.
-      * pclearbot. unpriv_co. right. eapply CIH; eauto with itree. apply H.
-      * pclearbot. unpriv_co. right. eapply CIH; eauto with itree. apply H.
+      *  unpriv_co. eapply CIH; eauto with itree. apply H.
+      *  unpriv_co. eapply CIH; eauto with itree. apply H.
       * rewrite itree_eta'. unpriv_ind. eapply H0; eauto.
       * destruct (observe t0).
         -- rewrite itree_eta' at 1. unpriv_ind.
            specialize (H a).
-           eapply eses_aux3; eauto.
-        -- unpriv_co. right. eapply CIH; eauto with itree. apply tau_eqit_secure.
-           pfold. apply H.
+           eapply eses_aux3; eauto. apply REL. 
+        -- unpriv_co. eapply CIH; eauto with itree. apply tau_eqit_secure.
+           step. apply H.
         -- destruct (classic (leq (priv _ e) l ) ).
            ++ rewrite itree_eta' at 1. unpriv_ind.
-              eapply eses_aux4; eauto.
+              eapply eses_aux4; eauto. apply REL. 
            ++ destruct (classic_empty X).
-              ** unpriv_halt. right. eapply CIH; eauto with itree. pfold. apply H.
-              ** unpriv_co. right. eapply CIH; eauto with itree.
-                 eapply unpriv_e_eqit_secure; eauto. pfold. apply H.
-      * pclearbot. unpriv_halt. right. eapply CIH; eauto. pfold.
+              ** unpriv_halt. eapply CIH; eauto with itree. step. apply H.
+              ** unpriv_co. eapply CIH; eauto with itree.
+                 eapply unpriv_e_eqit_secure; eauto. step. apply H.
+      *  unpriv_halt. eapply CIH; eauto. step.
         constructor; intros; auto with itree.
-      * pclearbot. unpriv_halt. right. eapply CIH; eauto with itree. apply H.
-      * pclearbot. unpriv_halt. right. eapply CIH; eauto with itree. apply H.
-        pfold. constructor; auto with itree.
-  - eapply IHHeutt; eauto. pstep_reverse. apply eqit_secure_sym.
-    apply tau_eqit_secure. apply eqit_secure_sym. pfold. auto.
+      *  unpriv_halt. eapply CIH; eauto with itree. apply H.
+      *  unpriv_halt. eapply CIH; eauto with itree. apply H.
+        step. constructor; auto with itree.
+  - eapply IHHeutt; eauto. unstep. apply eqit_secure_sym.
+    apply tau_eqit_secure. apply eqit_secure_sym. step. auto.
 Qed.
diff --git a/extra/Secure/SecureEqHalt.v b/extra/Secure/SecureEqHalt.v
index 2c1fc3a8..854a0679 100644
--- a/extra/Secure/SecureEqHalt.v
+++ b/extra/Secure/SecureEqHalt.v
@@ -1,3 +1,7 @@
+From Coinduction Require Import all. (* import for CompleteLattice instances; Preorder's leq is re-imported below via Labels and wins as the unqualified name *)
+From Stdlib Require Import Morphisms PeanoNat. 
+
+
 From ITree Require Import
      Basics.Utils
      Axioms
@@ -7,15 +11,11 @@ From ITree Require Import
 
 From ITree.Extra Require Export Secure.Labels.
 
-From Paco Require Import paco.
 
 Import Monads.
 Import MonadNotation.
 Local Open Scope monad_scope.
 
-Ltac pmonauto_itree :=
-  let IN := fresh "IN" in
-  try (repeat intro; destruct IN; eauto with paco itree; fail).
 
 (* will need more propositional constraints on Preorders *)
 
@@ -26,74 +26,63 @@ Section SecureUntimed.
   Context (RR : R1 -> R2 -> Prop).
 
   Coercion is_true : bool >-> Sortclass.
-  Inductive secure_eqitF (b1 b2 : bool) (l : L) vclo (sim : itree E R1 -> itree E R2 -> Prop) : itree' E R1 -> itree' E R2 -> Prop :=
+  Inductive secure_eqitF (b1 b2 : bool) (l : L) (sim : itree E R1 -> itree E R2 -> Prop) : itree' E R1 -> itree' E R2 -> Prop :=
 
     (* eqitF constructors *)
-    | secEqRet r1 r2 : RR r1 r2 -> secure_eqitF b1 b2 l vclo sim (RetF r1) (RetF r2)
-    | secEqTau t1 t2 : sim t1 t2 -> secure_eqitF b1 b2 l vclo sim (TauF t1) (TauF t2)
-    | secEqTauL t1 ot2 (CHECK : b1) : secure_eqitF b1 b2 l vclo sim (observe t1) ot2 -> secure_eqitF b1 b2 l vclo sim (TauF t1) ot2
-    | secEqTauR ot1 t2 (CHECK : b2) : secure_eqitF b1 b2 l vclo sim ot1 (observe t2) -> secure_eqitF b1 b2 l vclo sim ot1 (TauF t2)
+    | secEqRet r1 r2 : RR r1 r2 -> secure_eqitF b1 b2 l sim (RetF r1) (RetF r2)
+    | secEqTau t1 t2 : sim t1 t2 -> secure_eqitF b1 b2 l sim (TauF t1) (TauF t2)
+    | secEqTauL t1 ot2 (CHECK : b1) : secure_eqitF b1 b2 l sim (observe t1) ot2 -> secure_eqitF b1 b2 l sim (TauF t1) ot2
+    | secEqTauR ot1 t2 (CHECK : b2) : secure_eqitF b1 b2 l sim ot1 (observe t2) -> secure_eqitF b1 b2 l sim ot1 (TauF t2)
     (* info_flow protecting coinductive constructors *)
     | EqVisPriv {A} (e : E A) k1 k2 (SECCHECK : leq (priv A e) l) :
-        ((forall a, vclo sim (k1 a) (k2 a) : Prop)) -> secure_eqitF b1 b2 l vclo sim (VisF e k1) (VisF e k2)
+        ((forall a, sim (k1 a) (k2 a) : Prop)) -> secure_eqitF b1 b2 l sim (VisF e k1) (VisF e k2)
     | EqVisUnPrivTauLCo {A} (e : E A) k1 t2 (SECCHECK : ~ leq (priv A e) l) (SIZECHECK : nonempty A) :
-        (forall a, vclo sim (k1 a) t2) -> secure_eqitF b1 b2 l vclo sim (VisF e k1) (TauF t2)
+        (forall a, sim (k1 a) t2) -> secure_eqitF b1 b2 l sim (VisF e k1) (TauF t2)
     | EqVisUnPrivTauRCo {A} (e : E A) t1 k2 (SECCHECK : ~ leq (priv A e) l) (SIZECHECK : nonempty A) :
-        (forall a, vclo sim t1 (k2 a)) -> secure_eqitF b1 b2 l vclo sim (TauF t1) (VisF e k2)
+        (forall a, sim t1 (k2 a)) -> secure_eqitF b1 b2 l sim (TauF t1) (VisF e k2)
     | EqVisUnPrivVisCo {A B} (e1 : E A) (e2 : E B) k1 k2 (SECCHECK1 : ~ leq (priv A e1) l) (SECCHECK2 : ~ leq (priv B e2) l)
         (SIZECHECK1 : nonempty A ) (SIZECHECK2 : nonempty B) :
-        (forall a b, vclo sim (k1 a) (k2 b)) -> secure_eqitF b1 b2 l vclo sim (VisF e1 k1) (VisF e2 k2)
+        (forall a b, sim (k1 a) (k2 b)) -> secure_eqitF b1 b2 l sim (VisF e1 k1) (VisF e2 k2)
     (* info_flow protecting inductive constructors *)
     | EqVisUnPrivLInd {A} (e : E A) k1 t2 (CHECK : b1) (SECCHECK : ~ leq (priv A e) l) (SIZECHECK : nonempty A) :
-        (forall a, secure_eqitF b1 b2 l vclo sim (observe (k1 a)) (observe t2) ) ->
-        secure_eqitF b1 b2 l vclo sim (VisF e k1) (observe t2)
+        (forall a, secure_eqitF b1 b2 l sim (observe (k1 a)) (observe t2) ) ->
+        secure_eqitF b1 b2 l sim (VisF e k1) (observe t2)
     | EqVisUnPrivRInd {A} (e : E A) t1 k2 (CHECK : b2) (SECCHECK : ~ leq (priv A e) l) (SIZECHECK : nonempty A) :
-        (forall a, secure_eqitF b1 b2 l vclo sim (observe t1) (observe (k2 a) )) ->
-        secure_eqitF b1 b2 l vclo sim (observe t1) (VisF e k2)
+        (forall a, secure_eqitF b1 b2 l sim (observe t1) (observe (k2 a) )) ->
+        secure_eqitF b1 b2 l sim (observe t1) (VisF e k2)
     (* info_flow protecting constructors for halting events, should capture the notion that a secret halt means
        that either it halted or it is performing some secret or silent computation and you can't tell which *)
     | EqVisUnprivHaltLTauR {A} (e : E A) k1 t2 (SECCHECK : ~ leq (priv A e) l ) (SIZECHECK : empty A) :
-        sim (Vis e k1) t2 -> secure_eqitF b1 b2 l vclo sim (VisF e k1) (TauF t2)
+        sim (Vis e k1) t2 -> secure_eqitF b1 b2 l sim (VisF e k1) (TauF t2)
     | EqVisUnprivHaltRTauL {A} (e : E A) t1 k2 (SECCHECK : ~ leq (priv A e) l ) (SIZECHECK : empty A) :
-        sim t1 (Vis e k2) -> secure_eqitF b1 b2  l vclo sim (TauF t1) (VisF e k2)
+        sim t1 (Vis e k2) -> secure_eqitF b1 b2  l sim (TauF t1) (VisF e k2)
     | EqVisUnprivHaltLVisR {A B} (e1 : E A) (e2 : E B) k1 k2 (SECCHECK1 : ~ leq (priv A e1) l) (SECCHECK2 : ~ leq (priv B e2) l)
             (SIZECHECK : empty A) :
-      (forall b, vclo sim (Vis e1 k1) (k2 b) ) -> secure_eqitF b1 b2 l vclo sim (VisF e1 k1) (VisF e2 k2)
+      (forall b, sim (Vis e1 k1) (k2 b) ) -> secure_eqitF b1 b2 l sim (VisF e1 k1) (VisF e2 k2)
     | EqVisUnprivHaltRVisL {A B} (e1 : E A) (e2 : E B) k1 k2 (SECCHECK1 : ~ leq (priv A e1) l) (SECCHECK2 : ~ leq (priv B e2) l)
             (SIZECHECK : empty B) :
-        (forall a, vclo sim (k1 a) (Vis e2 k2)) -> secure_eqitF b1 b2 l vclo sim (VisF e1 k1) (VisF e2 k2)
+        (forall a, sim (k1 a) (Vis e2 k2)) -> secure_eqitF b1 b2 l sim (VisF e1 k1) (VisF e2 k2)
   .
 
   Hint Constructors secure_eqitF : itree.
 
-  Definition secure_eqit_ (b1 b2 : bool) (l : L) vclo (sim : itree E R1 -> itree E R2 -> Prop) : itree E R1 -> itree E R2 -> Prop :=
-    fun t1 t2 => secure_eqitF b1 b2 l vclo sim (observe t1) (observe t2).
+  Definition secure_eqit_ (b1 b2 : bool) (l : L) (sim : itree E R1 -> itree E R2 -> Prop) : itree E R1 -> itree E R2 -> Prop :=
+    fun t1 t2 => secure_eqitF b1 b2 l sim (observe t1) (observe t2).
 
   Hint Unfold secure_eqit_ : itree.
 
-  Lemma secure_eqitF_mono b1 b2 l x0 x1 vclo vclo' sim sim'
-        (IN: secure_eqitF b1 b2 l vclo sim x0 x1)
-        (MON: monotone2 vclo)
-        (LEc: vclo <3= vclo')
-        (LE: sim <2= sim'):
-    secure_eqitF b1 b2 l vclo' sim' x0 x1.
-  Proof.
-    intros. induction IN; eauto with itree.
-  Qed.
 
-  Lemma secure_eqit_mono b1 b2 l vclo (MON: monotone2 vclo) : monotone2 (secure_eqit_ b1 b2 l vclo).
+Lemma secure_eqitF_mono b1 b2 l :
+  Proper (respectful Coinduction.lattice.leq Coinduction.lattice.leq) 
+    (secure_eqit_ b1 b2 l).
   Proof.
-    do 2 red. intros; eapply secure_eqitF_mono; eauto.
+    intros!. red; red in H0. 
+    induction H0; try solve [constructor; intros; eauto with itree; now apply H].
   Qed.
 
-  Hint Resolve secure_eqit_mono : paco.
-
-  Definition eqit_secure b1 b2 l := paco2 (secure_eqit_ b1 b2 l id) bot2.
-
-  (* want and eqitC_secure which could help prove some interesting stuff
-
-   *)
+  Definition secure_eqit_mon b1 b2 l := Build_mon (secure_eqitF_mono b1 b2 l).
 
+  Definition eqit_secure b1 b2 l := gfp (secure_eqit_mon b1 b2 l).
 
   (*
     Note that this is not reflexive (think it is symmetric and transitive)
@@ -107,14 +96,12 @@ Section SecureUntimed.
 
 End SecureUntimed.
 
-#[global] Hint Resolve secure_eqit_mono : paco.
-
 #[global] Hint Constructors secure_eqitF : itree.
 
 Definition NatPreorder : Preorder :=
   {|
   L := nat;
-  leq := fun n m => n <= m
+  leq := fun n m => Nat.le n m
   |}.
 
 Ltac unpriv_co := try apply EqVisUnPrivVisCo;
@@ -128,10 +115,10 @@ Ltac unpriv_ind := try apply EqVisUnPrivLInd;
 
 Ltac unpriv_halt :=
   match goal with
-  | [  Hemp : empty ?A |- secure_eqitF _ _ _ _ _ _ _ _ (@VisF _ _ _ ?A _ _) _ ] =>
+  | [  Hemp : empty ?A |- secure_eqitF _ _ _ _ _ _ _ (@VisF _ _ _ ?A _ _) _ ] =>
     try apply EqVisUnprivHaltLTauR; try apply EqVisUnprivHaltLVisR; auto with itree; intros
 
-  | [  Hemp : empty ?A |- secure_eqitF _ _ _ _ _ _ _ _ _ (@VisF _ _ _ ?A _ _)  ] =>
+  | [  Hemp : empty ?A |- secure_eqitF _ _ _ _ _ _ _ _ (@VisF _ _ _ ?A _ _)  ] =>
     try apply EqVisUnprivHaltRTauL; try apply EqVisUnprivHaltRVisL; auto with itree; intros end.
 
 Section SecureUntimedUnReflexive.
@@ -141,6 +128,15 @@ Section eqit_secureC.
   Context {E: Type -> Type} {R1 R2 : Type} (RR : R1 -> R2 -> Prop).
   Context (Label : Preorder) (priv : forall A, E A -> L) (l : L).
 
+(* Lemma eqit_secure_trans b1 b1' b2 b2' r t1 t2 t1' t2' RR1 RR2
+      (EQVl: eqit_secure Label priv RR1 b1 b1' l t1 t1')
+      (EQVr: eqit_secure Label priv RR2 b2 b2' l t2 t2')
+      (REL: r t1' t2')
+      (LERR1: forall x x' y, RR1 x x' -> RR x' y -> RR x y)
+      (LERR2: forall x y y', RR2 y y' -> RR x y' -> RR x y) :
+      eqit_secure Label priv RR b1 b2' l t1 t2.
+
+
 
   Variant eqit_secure_trans_clo (b1 b2 b1' b2' : bool) (r : itree E R1 -> itree E R2 -> Prop) :
     itree E R1 -> itree E R2 -> Prop :=
@@ -163,56 +159,39 @@ Section eqit_secureC.
     eqit_secureC b1 b2 r2 t1 t2.
   Proof.
     destruct IN; eauto with itree.
-  Qed.
+  Qed. *)
 
 End eqit_secureC.
 
 
-Ltac gfinal_with H := gfinal; left; apply H.
-
+(* TOUR: This proof *)
 Lemma eqit_secure_sym : forall b1 b2 E R1 R2 RR Label priv l (t1 : itree E R1) (t2 : itree E R2),
-    eqit_secure Label priv RR b1 b2 l t1 t2 -> eqit_secure Label priv (flip RR) b2 b1 l t2 t1.
+    eqit_secure Label priv RR b1 b2 l t1 t2 -> eqit_secure Label priv (Basics.flip RR) b2 b1 l t2 t1.
 Proof.
-  intros b1 b2 E R1 R2 RR Label priv l. pcofix CIH.
-  intros t1 t2 Hsec. pfold. red. punfold Hsec. red in Hsec.
-  hinduction Hsec before r; intros; eauto with itree; pclearbot;
-  try (unpriv_co; right; apply CIH; apply H);
+  intros b1 b2 E R1 R2 RR Label priv l. icoinduction c CIH.
+  intros t1 t2 Hsec. step in Hsec.
+  hinduction Hsec before c; intros; eauto with itree; 
+  try (unpriv_co; apply CIH; apply H);
   try unpriv_halt.
-  - constructor; auto with itree. intros. right. apply CIH; apply H.
-  - specialize (H a). remember (k2 a) as t. clear Heqt k2.
-     left.
-     intros. pfold. red. cbn. punfold H. red in H. cbn in H.
-     inv H; ddestruction; subst; try contra_size; try contradiction; pclearbot; eauto;
-     try (unpriv_halt; fail).
-     +  unpriv_halt. right. apply CIH. pfold. auto.
-     + rewrite H0. rewrite H0 in H2. unpriv_halt.
-       right. apply CIH. pfold. apply H2.
-     + unpriv_halt. right. apply CIH. apply H1.
-     + unpriv_halt. right. apply CIH. apply H1.
-  - specialize (H b). remember (k1 b) as t. clear Heqt k1.
-     left.
-     intros. pfold. red. cbn. punfold H. red in H. cbn in H.
-     inv H; ddestruction; subst; try contra_size; try contradiction; pclearbot; eauto;
-     try (unpriv_halt; fail).
-     +  unpriv_halt. right. apply CIH. pfold. auto.
-     + rewrite H1. rewrite H1 in H2. unpriv_halt.
-       right. apply CIH. pfold. apply H2.
-     + unpriv_halt. inv SIZECHECK0. contradiction.
-     + unpriv_halt. right. apply CIH. apply H2.
-Qed.
+  - constructor; auto with itree. intros. apply CIH; apply H.
+  - eapply CIH. apply H. 
+  - eapply CIH. apply H. 
+Qed. 
 
-Lemma secure_eqit_mon : forall E (b1 b2 b3 b4 : bool) R1 R2 RR1 RR2 Label priv l
+Lemma secure_eqit_mono : forall E (b1 b2 b3 b4 : bool) R1 R2 RR1 RR2 Label priv l
       (t1 : itree E R1) (t2 : itree E R2),
-    (b1 -> b3) -> (b2 -> b4) -> (RR1 <2= RR2) ->
+    (b1 -> b3) -> (b2 -> b4) -> (RR1 <= RR2) ->
     eqit_secure Label priv RR1 b1 b2 l t1 t2 -> eqit_secure Label priv RR2 b3 b4 l t1 t2.
 Proof.
-  intros. generalize dependent t2. revert t1. pcofix CIH.
-  intros t1 t2 Ht12. pstep. red.
-  punfold Ht12. red in Ht12.
-  hinduction Ht12 before r; intros; eauto; pclearbot;
-  try (unpriv_co; right; apply CIH; try red; eauto; fail);
-  try (unpriv_halt; try contra_size; right; apply CIH; try red; eauto; fail).
-  constructor; auto. right.  eauto. apply CIH; apply H2.
+  intros. generalize dependent t2. revert t1. coinduction c CIH.
+  intros t1 t2 Ht12. icbn. 
+  step in Ht12.
+  hinduction Ht12 before l; intros; 
+  try (unpriv_co; apply CIH; try red; eauto; fail);
+  try (unpriv_halt; try contra_size; apply CIH; try red; eauto; fail); 
+  eauto with itree. 
+  - constructor; auto. now apply H2. 
+  - constructor; intros; eauto. eapply CIH. apply H. 
 Qed.
 
 End SecureUntimedUnReflexive.
diff --git a/extra/Secure/SecureEqHaltProgInsens.v b/extra/Secure/SecureEqHaltProgInsens.v
index aa7f5f16..542b06ed 100644
--- a/extra/Secure/SecureEqHaltProgInsens.v
+++ b/extra/Secure/SecureEqHaltProgInsens.v
@@ -1,3 +1,6 @@
+From Coinduction Require Import all. (* import for CompleteLattice instances; Preorder's leq is re-imported below via Labels and wins as the unqualified name *)
+From Stdlib Require Import Morphisms PeanoNat.
+
 From ITree Require Import
      Axioms
      ITree
@@ -6,8 +9,6 @@ From ITree Require Import
 
 From ITree.Extra Require Export Secure.Labels.
 
-From Paco Require Import paco.
-
 (* will need more propositional constraints on Preorders *)
 
 Section SecureUntimed.
@@ -18,69 +19,63 @@ Section SecureUntimed.
 
   Coercion is_true : bool >-> Sortclass.
 
-  Variant secure_eqitF (b1 b2 : bool) (l : L) vclo (sim : itree E R1 -> itree E R2 -> Prop) : itree' E R1 -> itree' E R2 -> Prop :=
+  Variant secure_eqitF (b1 b2 : bool) (l : L) (sim : itree E R1 -> itree E R2 -> Prop) : itree' E R1 -> itree' E R2 -> Prop :=
 
     (* eqitF constructors *)
-    | secEqRet r1 r2 : RR r1 r2 -> secure_eqitF b1 b2 l vclo sim (RetF r1) (RetF r2)
-    | secEqTau t1 t2 : sim t1 t2 -> secure_eqitF b1 b2 l vclo sim (TauF t1) (TauF t2)
-    | secEqTauL t1 t2 (CHECK : b1) : sim t1 t2 -> secure_eqitF b1 b2 l vclo sim (TauF t1) (observe t2)
-    | secEqTauR t1 t2 (CHECK : b2) : sim t1 t2 -> secure_eqitF b1 b2 l vclo sim (observe t1) (TauF t2)
+    | secEqRet r1 r2 : RR r1 r2 -> secure_eqitF b1 b2 l sim (RetF r1) (RetF r2)
+    | secEqTau t1 t2 : sim t1 t2 -> secure_eqitF b1 b2 l sim (TauF t1) (TauF t2)
+    | secEqTauL t1 t2 (CHECK : b1) : sim t1 t2 -> secure_eqitF b1 b2 l sim (TauF t1) (observe t2)
+    | secEqTauR t1 t2 (CHECK : b2) : sim t1 t2 -> secure_eqitF b1 b2 l sim (observe t1) (TauF t2)
     (* info_flow protecting coinductive constructors *)
     | EqVisPriv {A} (e : E A) k1 k2 (SECCHECK : leq (priv A e) l) :
-        ((forall a, vclo sim (k1 a) (k2 a) : Prop)) -> secure_eqitF b1 b2 l vclo sim (VisF e k1) (VisF e k2)
+        ((forall a, sim (k1 a) (k2 a) : Prop)) -> secure_eqitF b1 b2 l sim (VisF e k1) (VisF e k2)
     | EqVisUnPrivTauLCo {A} (e : E A) k1 t2 (SECCHECK : ~ leq (priv A e) l) (SIZECHECK : nonempty A) :
-        (forall a, vclo sim (k1 a) t2) -> secure_eqitF b1 b2 l vclo sim (VisF e k1) (TauF t2)
+        (forall a, sim (k1 a) t2) -> secure_eqitF b1 b2 l sim (VisF e k1) (TauF t2)
     | EqVisUnPrivTauRCo {A} (e : E A) t1 k2 (SECCHECK : ~ leq (priv A e) l) (SIZECHECK : nonempty A) :
-        (forall a, vclo sim t1 (k2 a)) -> secure_eqitF b1 b2 l vclo sim (TauF t1) (VisF e k2)
+        (forall a, sim t1 (k2 a)) -> secure_eqitF b1 b2 l sim (TauF t1) (VisF e k2)
     | EqVisUnPrivVisCo {A B} (e1 : E A) (e2 : E B) k1 k2 (SECCHECK1 : ~ leq (priv A e1) l) (SECCHECK2 : ~ leq (priv B e2) l)
         (SIZECHECK1 : nonempty A ) (SIZECHECK2 : nonempty B) :
-        (forall a b, vclo sim (k1 a) (k2 b)) -> secure_eqitF b1 b2 l vclo sim (VisF e1 k1) (VisF e2 k2)
+        (forall a b, sim (k1 a) (k2 b)) -> secure_eqitF b1 b2 l sim (VisF e1 k1) (VisF e2 k2)
     (* info_flow protecting inductive constructors *)
     | EqVisUnPrivLInd {A} (e : E A) k1 t2 (CHECK : b1) (SECCHECK : ~ leq (priv A e) l) (SIZECHECK : nonempty A) :
-        (forall a, vclo sim (k1 a) t2) ->
-        secure_eqitF b1 b2 l vclo sim (VisF e k1) (observe t2)
+        (forall a, sim (k1 a) t2) ->
+        secure_eqitF b1 b2 l sim (VisF e k1) (observe t2)
     | EqVisUnPrivRInd {A} (e : E A) t1 k2 (CHECK : b2) (SECCHECK : ~ leq (priv A e) l) (SIZECHECK : nonempty A) :
-        (forall a, vclo sim t1 (k2 a) ) ->
-        secure_eqitF b1 b2 l vclo sim (observe t1) (VisF e k2)
+        (forall a, sim t1 (k2 a) ) ->
+        secure_eqitF b1 b2 l sim (observe t1) (VisF e k2)
     (* info_flow protecting constructors for halting events, should capture the notion that a secret halt means
        that either it halted or it is performing some secret or silent computation and you can't tell which *)
     | EqVisUnprivHaltLTauR {A} (e : E A) k1 t2 (SECCHECK : ~ leq (priv A e) l ) (SIZECHECK : empty A) :
-        sim (Vis e k1) t2 -> secure_eqitF b1 b2 l vclo sim (VisF e k1) (TauF t2)
+        sim (Vis e k1) t2 -> secure_eqitF b1 b2 l sim (VisF e k1) (TauF t2)
     | EqVisUnprivHaltRTauL {A} (e : E A) t1 k2 (SECCHECK : ~ leq (priv A e) l ) (SIZECHECK : empty A) :
-        sim t1 (Vis e k2) -> secure_eqitF b1 b2  l vclo sim (TauF t1) (VisF e k2)
+        sim t1 (Vis e k2) -> secure_eqitF b1 b2  l sim (TauF t1) (VisF e k2)
     | EqVisUnprivHaltLVisR {A B} (e1 : E A) (e2 : E B) k1 k2 (SECCHECK1 : ~ leq (priv A e1) l) (SECCHECK2 : ~ leq (priv B e2) l)
             (SIZECHECK : empty A) :
-      (forall b, vclo sim (Vis e1 k1) (k2 b) ) -> secure_eqitF b1 b2 l vclo sim (VisF e1 k1) (VisF e2 k2)
+      (forall b, sim (Vis e1 k1) (k2 b) ) -> secure_eqitF b1 b2 l sim (VisF e1 k1) (VisF e2 k2)
     | EqVisUnprivHaltRVisL {A B} (e1 : E A) (e2 : E B) k1 k2 (SECCHECK1 : ~ leq (priv A e1) l) (SECCHECK2 : ~ leq (priv B e2) l)
             (SIZECHECK : empty B) :
-        (forall a, vclo sim (k1 a) (Vis e2 k2)) -> secure_eqitF b1 b2 l vclo sim (VisF e1 k1) (VisF e2 k2)
+        (forall a, sim (k1 a) (Vis e2 k2)) -> secure_eqitF b1 b2 l sim (VisF e1 k1) (VisF e2 k2)
   .
 
   Hint Constructors secure_eqitF : itree.
 
-  Definition secure_eqit_ (b1 b2 : bool) (l : L) vclo (sim : itree E R1 -> itree E R2 -> Prop) : itree E R1 -> itree E R2 -> Prop :=
-    fun t1 t2 => secure_eqitF b1 b2 l vclo sim (observe t1) (observe t2).
+  Definition secure_eqit_ (b1 b2 : bool) (l : L) (sim : itree E R1 -> itree E R2 -> Prop) : itree E R1 -> itree E R2 -> Prop :=
+    fun t1 t2 => secure_eqitF b1 b2 l sim (observe t1) (observe t2).
 
   Hint Unfold secure_eqit_ : itree.
 
-  Lemma secure_eqitF_mono b1 b2 l x0 x1 vclo vclo' sim sim'
-        (IN: secure_eqitF b1 b2 l vclo sim x0 x1)
-        (MON: monotone2 vclo)
-        (LEc: vclo <3= vclo')
-        (LE: sim <2= sim'):
-    secure_eqitF b1 b2 l vclo' sim' x0 x1.
+  Lemma secure_eqitF_mono b1 b2 l :
+    Proper (Coinduction.lattice.leq ==> Coinduction.lattice.leq)
+      (secure_eqit_ b1 b2 l).
   Proof.
-    intros. induction IN; eauto with itree.
-  Qed.
+    intros!. red; red in H0.
+    destruct H0; try solve [constructor; intros; eauto with itree; now apply H].
 
-  Lemma secure_eqit_mono b1 b2 l vclo (MON: monotone2 vclo) : monotone2 (secure_eqit_ b1 b2 l vclo).
-  Proof.
-    do 2 red. intros; eapply secure_eqitF_mono; eauto.
   Qed.
 
-  Hint Resolve secure_eqit_mono : paco.
+  Definition secure_eqit_mon b1 b2 l := Build_mon (secure_eqitF_mono b1 b2 l).
 
-  Definition eqit_secure b1 b2 l := paco2 (secure_eqit_ b1 b2 l id) bot2.
+  Definition eqit_secure b1 b2 l := gfp (secure_eqit_mon b1 b2 l).
 
   (* want and eqitC_secure which could help prove some interesting stuff
 
@@ -99,14 +94,12 @@ Section SecureUntimed.
 
 End SecureUntimed.
 
-#[export] Hint Resolve secure_eqit_mono : paco.
-
 #[export] Hint Constructors secure_eqitF : itree.
 
 Definition NatPreorder : Preorder :=
   {|
   L := nat;
-  leq := fun n m => n <= m
+  leq := fun n m => Nat.le n m
   |}.
 
 Section SecureUntimedUnReflexive.
@@ -151,10 +144,10 @@ Definition halt : itree E R := Vis HaltE (fun _ => Tau Tau ...)
 
   Lemma refl_counter_counter : ~ eqit_secure NatPreorder priv_counter eq true true 0 refl_counter refl_counter.
     Proof.
-      intro Hcontra. punfold Hcontra; try eapply secure_eqit_mono; eauto.
+      intro Hcontra. step in Hcontra; try eapply secure_eqit_mono; eauto.
       red in Hcontra. cbn in *. inv Hcontra; ddestruction; subst.
       - cbv in SECCHECK. inv SECCHECK.
-      - specialize (H0 true false). pclearbot. pinversion H0; try eapply secure_eqit_mono; eauto.
+      - specialize (H0 true false).  sinv H0; try eapply secure_eqit_mono; eauto.
         discriminate.
       - rewrite H3 in H0. clear H3. specialize (H0 true). cbn in *.
         inv H0; ddestruction; subst. specialize (H2 false). rewrite H in H2.
@@ -169,13 +162,13 @@ Definition halt : itree E R := Vis HaltE (fun _ => Tau Tau ...)
 
     Lemma halt_not_ret : forall A (a : A) k, ~ eqit_secure NatPreorder priv_counter eq true true 0 (Vis Halt k) (Ret a).
     Proof.
-      intros. intro Hcontra. pinversion Hcontra. ddestruction; subst.
+      intros. intro Hcontra. sinv Hcontra. ddestruction; subst.
       inv SIZECHECK. contradiction.
     Qed.
 
     Lemma halt_spin : eqit_secure NatPreorder priv_counter eq true true 0 (trigger Halt) (ITree.spin).
     Proof.
-      pcofix CIH. pfold. red. cbn. eapply EqVisUnprivHaltLTauR.
+      coinduction c CIH. step. cbn. eapply EqVisUnprivHaltLTauR.
       - intro. inv H.
       - constructor. intros; contradiction.
       - right. apply CIH.
@@ -188,10 +181,10 @@ Definition halt : itree E R := Vis HaltE (fun _ => Tau Tau ...)
     (* b := SecretFlip; if b then return tt else PublicOut; return tt*)
     Lemma refl_counter2_counter : ~ eqit_secure NatPreorder priv_counter eq true true 0 refl_counter2 refl_counter2.
       Proof.
-        unfold refl_counter2. intro Hcontra. punfold Hcontra; try eapply secure_eqit_mono; eauto.
+        unfold refl_counter2. intro Hcontra. step in Hcontra; try eapply secure_eqit_mono; eauto.
         red in Hcontra. cbn in Hcontra. inv Hcontra; ddestruction; subst; try (inv SIZECHECK; apply H; constructor; fail).
         - inv SECCHECK.
-        - specialize (H0 true false). pclearbot. punfold H0; try eapply secure_eqit_mono; eauto.
+        - specialize (H0 true false).  step in H0; try eapply secure_eqit_mono; eauto.
           red in H0. cbn in *. inv H0; ddestruction; subst.
           cbn in *. apply SECCHECK; auto.
         - rewrite H3 in H0; clear H3. specialize (H0 true). cbn in *.
@@ -228,7 +221,7 @@ Section eqit_secureC.
 
   Lemma eqit_secureC_mon b1 b2 r1 r2 t1 t2
     (IN : eqit_secureC b1 b2 r1 t1 t2)
-    (LE: r1 <2= r2) :
+    (LE: forall x y, r1 x y -> r2 x y) :
     eqit_secureC b1 b2 r2 t1 t2.
   Proof.
     destruct IN; eauto with itree.
@@ -264,51 +257,30 @@ Ltac unpriv_halt := try apply EqVisUnprivHaltLTauR;
                     try apply EqVisUnprivHaltRTauL;
                     try apply
 *)
-Ltac gfinal_with H := gfinal; left; apply H.
 
 Ltac ne A := let Hne := fresh "H" in assert (Hne : nonempty A); eauto; inv Hne.
 
 Lemma eqit_secure_sym : forall b1 b2 E R1 R2 RR Label priv l (t1 : itree E R1) (t2 : itree E R2),
-    eqit_secure Label priv RR b1 b2 l t1 t2 -> eqit_secure Label priv (flip RR) b2 b1 l t2 t1.
+    eqit_secure Label priv RR b1 b2 l t1 t2 -> eqit_secure Label priv (Basics.flip RR) b2 b1 l t2 t1.
 Proof.
-  intros b1 b2 E R1 R2 RR Label priv l. pcofix CIH.
-  intros t1 t2 Hsec. pfold. red. punfold Hsec. red in Hsec.
-  hinduction Hsec before r; intros; eauto with itree; pclearbot;
-  try (unpriv_co; right; apply CIH; apply H);
-  try unpriv_halt.
-  - constructor; auto. intros. right. apply CIH; apply H.
-  - constructor; auto. right. eapply CIH. apply H.
-  - constructor; auto. right. eapply CIH. apply H.
-  - specialize (H a). remember (k2 a) as t. clear Heqt k2.
-     left.
-     intros. pfold. red. cbn. punfold H. red in H. cbn in H.
-     inv H; ddestruction; subst; try contra_size; try contradiction; pclearbot; eauto with itree;
-     try (unpriv_halt; fail).
-     + constructor; auto. right. eapply CIH; eauto. apply H2.
-     + unpriv_halt. right. eapply CIH. apply H1.
-     + unpriv_halt. right. eapply CIH. apply H1.
-  - specialize (H b). remember (k1 b) as t. clear Heqt k1.
-     left.
-     intros. pfold. red. cbn. punfold H. red in H. cbn in H.
-     inv H; ddestruction; subst; try contra_size; try contradiction; pclearbot; eauto with itree;
-     try (unpriv_halt; fail).
-     + constructor; auto. right. eapply CIH; eauto. apply H2.
-     + unpriv_halt. right. inv SIZECHECK0. contradiction.
-     + unpriv_halt. right. eapply CIH. apply H2.
-Qed.
+  intros b1 b2 E R1 R2 RR Label priv l. icoinduction c CIH.
+  intros t1 t2 Hsec. step in Hsec.
+  hinduction Hsec before c; intros; 
+  try (constructor; eauto; intros; apply CIH; apply H).
+Qed. 
 
-Lemma secure_eqit_mon : forall E (b1 b2 b3 b4 : bool) R1 R2 RR1 RR2 Label priv l
+Lemma secure_eqit_mono : forall E (b1 b2 b3 b4 : bool) R1 R2 RR1 RR2 Label priv l
       (t1 : itree E R1) (t2 : itree E R2),
-    (b1 -> b3) -> (b2 -> b4) -> (RR1 <2= RR2) ->
+    (b1 -> b3) -> (b2 -> b4) -> (RR1 <= RR2) ->
     eqit_secure Label priv RR1 b1 b2 l t1 t2 -> eqit_secure Label priv RR2 b3 b4 l t1 t2.
 Proof.
-  intros. generalize dependent t2. revert t1. pcofix CIH.
-  intros t1 t2 Ht12. pstep. red.
-  punfold Ht12. red in Ht12.
-  hinduction Ht12 before r; intros; eauto; pclearbot;
-  try (unpriv_co; right; apply CIH; try red; eauto; fail);
-  try (unpriv_halt; try contra_size; right; apply CIH; try red; eauto; fail).
-  all : (constructor; auto; right;  eauto; apply CIH; apply H2).
+  intros. generalize dependent t2. revert t1. coinduction c CIH.
+  intros t1 t2 Ht12. icbn. 
+  step in Ht12.
+  hinduction Ht12 before l; intros; 
+  try (constructor; eauto; intros; apply CIH; apply H); 
+  eauto with itree. 
+  - constructor; auto. now apply H2. 
 Qed.
 
 End SecureUntimedUnReflexive.
diff --git a/extra/Secure/SecureEqProgInsens.v b/extra/Secure/SecureEqProgInsens.v
index ffb44960..bf266a62 100644
--- a/extra/Secure/SecureEqProgInsens.v
+++ b/extra/Secure/SecureEqProgInsens.v
@@ -1,4 +1,5 @@
-From Coq Require Import Morphisms.
+From Coinduction Require Import all.
+From Stdlib Require Import Morphisms Program.Basics.
 
 From ITree Require Import
      Axioms
@@ -9,7 +10,6 @@ From ITree.Extra Require Import
      Secure.SecureEqHalt
 .
 
-From Paco Require Import paco.
 
 Import Monads.
 Import MonadNotation.
@@ -29,67 +29,55 @@ Section SecureProgInsens.
   want it to be an equivalence
   *)
 
-  Variant pi_secure_eqitF (b1 b2 : bool) (l : L) vclo (sim : itree E R1 -> itree E R2 -> Prop) : itree' E R1 -> itree' E R2 -> Prop :=
+  Variant pi_secure_eqitF (b1 b2 : bool) (l : L) (sim : itree E R1 -> itree E R2 -> Prop) : itree' E R1 -> itree' E R2 -> Prop :=
 
     (* eqitF constructors *)
-    | pisecEqRet r1 r2 : RR r1 r2 -> pi_secure_eqitF b1 b2 l vclo sim (RetF r1) (RetF r2)
-    | pisecEqTau t1 t2 : sim t1 t2 -> pi_secure_eqitF b1 b2 l vclo sim (TauF t1) (TauF t2)
-    | pisecEqTauL t1 t2 (CHECK : b1) : sim t1 t2 -> pi_secure_eqitF b1 b2 l vclo sim (TauF t1) (observe t2)
-    | pisecEqTauR t1 t2 (CHECK : b2) : sim t1 t2 -> pi_secure_eqitF b1 b2 l vclo sim (observe t1) (TauF t2)
+    | pisecEqRet r1 r2 : RR r1 r2 -> pi_secure_eqitF b1 b2 l sim (RetF r1) (RetF r2)
+    | pisecEqTau t1 t2 : sim t1 t2 -> pi_secure_eqitF b1 b2 l sim (TauF t1) (TauF t2)
+    | pisecEqTauL t1 t2 (CHECK : b1) : sim t1 t2 -> pi_secure_eqitF b1 b2 l sim (TauF t1) (observe t2)
+    | pisecEqTauR t1 t2 (CHECK : b2) : sim t1 t2 -> pi_secure_eqitF b1 b2 l sim (observe t1) (TauF t2)
     (* info_flow protecting coinductive constructors *)
     | piEqVisPriv {A} (e : E A) k1 k2 (SECCHECK : leq (priv A e) l) :
-        ((forall a, vclo sim (k1 a) (k2 a) : Prop)) -> pi_secure_eqitF b1 b2 l vclo sim (VisF e k1) (VisF e k2)
+        ((forall a, sim (k1 a) (k2 a) : Prop)) -> pi_secure_eqitF b1 b2 l sim (VisF e k1) (VisF e k2)
     | piEqVisUnPrivTauLCo {A} (e : E A) k1 t2 (SECCHECK : ~ leq (priv A e) l) :
-        (forall a, vclo sim (k1 a) t2) -> pi_secure_eqitF b1 b2 l vclo sim (VisF e k1) (TauF t2)
+        (forall a, sim (k1 a) t2) -> pi_secure_eqitF b1 b2 l sim (VisF e k1) (TauF t2)
     | piEqVisUnPrivTauRCo {A} (e : E A) t1 k2 (SECCHECK : ~ leq (priv A e) l) :
-        (forall a, vclo sim t1 (k2 a)) -> pi_secure_eqitF b1 b2 l vclo sim (TauF t1) (VisF e k2)
+        (forall a, sim t1 (k2 a)) -> pi_secure_eqitF b1 b2 l sim (TauF t1) (VisF e k2)
     | piEqVisUnPrivVisCo {A B} (e1 : E A) (e2 : E B) k1 k2 (SECCHECK1 : ~ leq (priv A e1) l) (SECCHECK2 : ~ leq (priv B e2) l)
         :
-        (forall a b, vclo sim (k1 a) (k2 b)) -> pi_secure_eqitF b1 b2 l vclo sim (VisF e1 k1) (VisF e2 k2)
+        (forall a b, sim (k1 a) (k2 b)) -> pi_secure_eqitF b1 b2 l sim (VisF e1 k1) (VisF e2 k2)
     (* info_flow protecting inductive constructors *)
     | piEqVisUnPrivLInd {A} (e : E A) k1 t2 (CHECK : b1) (SECCHECK : ~ leq (priv A e) l) :
-        (forall a, vclo sim (k1 a) t2 ) ->
-        pi_secure_eqitF b1 b2 l vclo sim (VisF e k1) (observe t2)
+        (forall a, sim (k1 a) t2 ) ->
+        pi_secure_eqitF b1 b2 l sim (VisF e k1) (observe t2)
     | piEqVisUnPrivRInd {A} (e : E A) t1 k2 (CHECK : b2) (SECCHECK : ~ leq (priv A e) l) :
-        (forall a, vclo sim t1 (k2 a) ) ->
-        pi_secure_eqitF b1 b2 l vclo sim (observe t1) (VisF e k2)
+        (forall a, sim t1 (k2 a) ) ->
+        pi_secure_eqitF b1 b2 l sim (observe t1) (VisF e k2)
   .
 
   Hint Constructors pi_secure_eqitF : itree.
 
-  Definition pi_secure_eqit_ (b1 b2 : bool) (l : L) vclo (sim : itree E R1 -> itree E R2 -> Prop) : itree E R1 -> itree E R2 -> Prop :=
-    fun t1 t2 => pi_secure_eqitF b1 b2 l vclo sim (observe t1) (observe t2).
+  Definition pi_secure_eqit_ (b1 b2 : bool) (l : L) (sim : itree E R1 -> itree E R2 -> Prop) : itree E R1 -> itree E R2 -> Prop :=
+    fun t1 t2 => pi_secure_eqitF b1 b2 l sim (observe t1) (observe t2).
 
   Hint Unfold pi_secure_eqit_ : itree.
 
-  Lemma pi_secure_eqitF_mono b1 b2 l x0 x1 vclo vclo' sim sim'
-        (IN: pi_secure_eqitF b1 b2 l vclo sim x0 x1)
-        (MON: monotone2 vclo)
-        (LEc: vclo <3= vclo')
-        (LE: sim <2= sim'):
-    pi_secure_eqitF b1 b2 l vclo' sim' x0 x1.
+  Lemma pi_secure_eqitF_mono b1 b2 l :
+    Proper (respectful Coinduction.lattice.leq Coinduction.lattice.leq)
+      (pi_secure_eqit_ b1 b2 l).
   Proof.
-    intros. induction IN; eauto with itree.
+    intros!. red; red in H0.
+    induction H0; try solve [constructor; intros; eauto with itree; now apply H].
   Qed.
 
-  Lemma pi_secure_eqit_mono b1 b2 l vclo (MON: monotone2 vclo) : monotone2 (pi_secure_eqit_ b1 b2 l vclo).
-  Proof.
-    do 2 red. intros; eapply pi_secure_eqitF_mono; eauto with itree.
-  Qed.
-
-  Hint Resolve pi_secure_eqit_mono : paco.
-
-  Definition pi_eqit_secure b1 b2 l := paco2 (pi_secure_eqit_ b1 b2 l id) bot2.
-
-  (* want and eqitC_secure which could help prove some interesting stuff
-
-   *)
+  Definition pi_secure_eqit_mon b1 b2 l := Build_mon (pi_secure_eqitF_mono b1 b2 l).
 
+  Definition pi_eqit_secure b1 b2 l := gfp (pi_secure_eqit_mon b1 b2 l).
 
 End SecureProgInsens.
 
-#[export] Hint Resolve pi_secure_eqit_mono : paco.
 #[export] Hint Constructors pi_secure_eqitF : itree.
+#[global] Hint Constructors pi_secure_eqitF : itree.
 
 Ltac unpriv_pi := try apply piEqVisUnPrivVisCo;
                   try apply piEqVisUnPrivTauLCo;
@@ -102,82 +90,85 @@ Ltac contra_size :=
   match goal with
   | [ Hemp : empty ?A, Hne : nonempty ?A |- _ ] => inv Hemp; inv Hne; contradiction end.
 
+#[local] Ltac taul := apply pisecEqTauL; [auto|].
+#[local] Ltac taur := apply pisecEqTauR; [auto|].
 
 Lemma eqit_secure_imp_pi_eqit_scure b1 b2 E R1 R2 RR Label priv l : forall (t1 : itree E R1) (t2 : itree E R2),
     eqit_secure Label priv RR b1 b2 l t1 t2 -> pi_eqit_secure Label priv RR b1 b2 l t1 t2.
 Proof.
-  pcofix CIH. intros t1 t2 Hps. pfold. red. punfold Hps. red in Hps.
-  hinduction Hps before r; intros.
+  icoinduction c CIH. intros t1 t2 Hps. step in Hps.
+  hinduction Hps before c; intros.
   - constructor; auto with itree.
-  - constructor. right. pclearbot. eauto with itree.
-  - rewrite itree_eta'. constructor; auto with itree. right. eapply CIH. pfold. apply Hps.
-  - rewrite itree_eta' at 1. constructor; auto with itree. right. eapply CIH. pfold. apply Hps.
-  - pclearbot. constructor; auto with itree. right. eapply CIH; eauto with itree. apply H.
-  - pclearbot. unpriv_pi. right. eapply CIH; apply H.
-  - pclearbot. unpriv_pi. right. eapply CIH; apply H.
-  - pclearbot. unpriv_pi. right. eapply CIH; apply H.
-  - pclearbot. unpriv_pi. right. eapply CIH. pfold. apply H.
-  - pclearbot. unpriv_pi. right. eapply CIH. pfold. apply H.
-  - unpriv_pi. inv SIZECHECK. contradiction.
-  - unpriv_pi. inv SIZECHECK. contradiction.
-  - unpriv_pi. inv SIZECHECK. contradiction.
-  - unpriv_pi. inv SIZECHECK. contradiction.
+  - constructor. apply CIH. apply H.
+  - rewrite itree_eta'. constructor; auto with itree. eapply CIH. step. apply Hps.
+  - rewrite itree_eta' at 1. constructor; auto with itree. eapply CIH. step. apply Hps.
+  - constructor; auto with itree. intros. apply CIH. apply H.
+  - unpriv_pi. eapply CIH; apply H.
+  - unpriv_pi. eapply CIH; apply H.
+  - unpriv_pi. eapply CIH; apply H.
+  - unpriv_pi. eapply CIH. step. apply H.
+  - unpriv_pi. eapply CIH. step. apply H.
+  - unpriv_pi; inv SIZECHECK; contradiction.
+  - unpriv_pi; inv SIZECHECK; contradiction.
+  - unpriv_pi; inv SIZECHECK; contradiction.
+  - unpriv_pi; inv SIZECHECK; contradiction.
 Qed.
 
 
 Lemma pi_eqit_secure_sym b1 b2 E R1 R2 RR Label priv l : forall (t1 : itree E R1) (t2 : itree E R2),
     pi_eqit_secure Label priv RR b1 b2 l t1 t2 -> pi_eqit_secure Label priv (flip RR) b2 b1 l t2 t1.
 Proof.
-  pcofix CIH. intros t1 t2 Hsec.
-  punfold Hsec. pfold. red in Hsec. red. inversion Hsec; pclearbot; eauto;
-  try (unpriv_pi; right; eapply CIH; apply H1; fail).
-  constructor; auto. right. eapply CIH; apply H1.
+  icoinduction c CIH. intros t1 t2 Hsec. step in Hsec.
+  hinduction Hsec before c; intros; eauto with itree;
+  try (unpriv_pi; apply CIH; apply H; fail).
+  constructor; auto. intros. apply CIH. apply H.
 Qed.
 
 
-Lemma pi_secure_eqit_mon : forall E (b1 b2 b3 b4 : bool) R1 R2 RR1 RR2 Label priv l
+Lemma pi_secure_eqit_mono : forall E (b1 b2 b3 b4 : bool) R1 R2 RR1 RR2 Label priv l
       (t1 : itree E R1) (t2 : itree E R2),
-    (b1 -> b3) -> (b2 -> b4) -> (RR1 <2= RR2) ->
+    (b1 -> b3) -> (b2 -> b4) -> (RR1 <= RR2) ->
     pi_eqit_secure Label priv RR1 b1 b2 l t1 t2 -> pi_eqit_secure Label priv RR2 b3 b4 l t1 t2.
 Proof.
-  intros. generalize dependent t2. revert t1. pcofix CIH.
-  intros t1 t2 Ht12. pstep. red.
-  punfold Ht12. red in Ht12.
-  hinduction Ht12 before r; intros; eauto; pclearbot;
-  try (unpriv_pi; right; apply CIH; try red; eauto; fail);
-  constructor; auto. right.  eauto. apply CIH; apply H2.
+  intros. generalize dependent t2. revert t1. coinduction c CIH.
+  intros t1 t2 Ht12. icbn.
+  step in Ht12.
+  hinduction Ht12 before l; intros;
+  try (unpriv_pi; apply CIH; try red; eauto; fail);
+  eauto with itree.
+  - constructor; auto. now apply H2.
+  - constructor; intros; eauto. eapply CIH. apply H.
 Qed.
 
 
 Lemma pi_eqit_secure_spin b E R1 R2 (RR : R1 -> R2 -> Prop) Label priv l : forall (t1 : itree E R1),
     pi_eqit_secure Label priv RR b true l t1 (ITree.spin).
 Proof.
-  pcofix CIH. intros. pfold. red. cbn. constructor; auto.
+  icoinduction c CIH. intros. cbn. constructor; auto.
 Qed.
 
 Lemma pi_eqit_secure_private_halt b E R1 R2 (RR : R1 -> R2 -> Prop) Label priv l A (e : E A) k:
   empty A -> ~ leq (priv A e) l -> forall (t1 : itree E R1),
     pi_eqit_secure Label priv RR b true l t1 (Vis e k).
 Proof.
-  intros HA t1. pfold. red. cbn. intros. unpriv_pi. inv HA; contradiction.
+  intros HA Hleq t1. step. cbn. unpriv_pi. inv HA; contradiction.
 Qed.
 
 Lemma pi_eqit_secure_mixed_trans_aux1:
   forall (E : Type -> Type) (R1 : Type) (b2 : bool) (R2 : Type) (RR1 : R1 -> R2 -> Prop)
     (Label : Preorder) (priv : forall A : Type, E A -> L) (l : L) t1 t2,
-    paco2 (pi_secure_eqit_ Label priv RR1 true b2 l id) bot2 t1 (Tau t2)  ->
+    pi_eqit_secure Label priv RR1 true b2 l t1 (Tau t2)  ->
     pi_eqit_secure Label priv RR1 true b2 l t1 t2.
 Proof.
-  intros E R1 b2 R2 RR1 Label priv l. pcofix CIH.
-  intros t1 t2 Htau. punfold Htau. red in Htau.
-  pfold. red. cbn in *. inv Htau; pclearbot; eauto.
-  - constructor; auto. left. eapply paco2_mon; eauto. intros; contradiction.
-  - constructor; auto. right. eapply CIH; eauto. pfold. red. rewrite <- H0.
-    cbn. pstep_reverse.
-  - pstep_reverse. eapply paco2_mon; eauto. intros; contradiction.
-  - unpriv_pi. left.  eapply paco2_mon; eauto. intros; contradiction.
-  - unpriv_pi. right. eapply CIH. pfold. red. rewrite <- H0.
-    cbn. pstep_reverse.
+  intros E R1 b2 R2 RR1 Label priv l. coinduction c CIH.
+  intros t1 t2 Htau. step in Htau.
+  icbn. cbn in *.
+  inv Htau; eauto with itree.
+  - constructor; auto. apply (gfp_chain c). apply H1.
+  - constructor; auto. apply CIH. step. rewrite <- H0. step in H1. apply H1.
+  - apply (gfp_bchain c). apply H1.
+  - unpriv_pi. apply (gfp_chain c). apply H1.
+  - unpriv_pi. apply CIH. step. rewrite <- H0. specialize (H1 a). step in H1. apply H1.
 Qed.
 
 Lemma pi_eqit_secure_mixed_trans b1 b2 E R1 R2 R3 (RR1 : R1 -> R2 -> Prop) (RR2 : R2 -> R3 -> Prop)
@@ -185,43 +176,30 @@ Lemma pi_eqit_secure_mixed_trans b1 b2 E R1 R2 R3 (RR1 : R1 -> R2 -> Prop) (RR2
     pi_eqit_secure Label priv RR1 b1 b2 l t1 t2 -> eqit RR2 b1 b2 t2 t3 ->
     pi_eqit_secure Label priv (rcompose RR1 RR2) b1 b2 l t1 t3.
 Proof.
-  pcofix CIH. intros t1 t2 t3 Hsec Heq. punfold Heq.
-  red in Heq. punfold Hsec. red in Hsec. pfold. red.
-  hinduction Heq before r; intros; try inv CHECK; pclearbot.
-  - inv Hsec; eauto with itree; unpriv_pi; pclearbot.
-    + rewrite itree_eta'. constructor; auto with itree. right. eapply CIH; eauto.
-      pfold. red. rewrite H0. constructor. auto.
-    + rewrite itree_eta'. unpriv_pi. right. eapply CIH; eauto.
-      apply H1. pfold. red. rewrite H0. constructor; auto.
-  - inv Hsec; pclearbot; eauto with itree.
-    + constructor. right. eapply CIH; eauto with itree.
-      pfold. red. rewrite H0. constructor; auto. pstep_reverse.
-    + unpriv_pi. right. eapply CIH; eauto. apply H1.
-    + rewrite itree_eta'. unpriv_pi. right. eapply CIH; eauto.
-      inv CHECK. apply pi_eqit_secure_mixed_trans_aux1.
-      pfold. red. rewrite <- H0. cbn. pstep_reverse.
+  coinduction c CIH. intros t1 t2 t3 Hsec Heq.
+  step in Heq. step in Hsec. icbn. cbn in *.
+  hinduction Heq before c; intros.
+  - inv Hsec; eauto with itree; unpriv_pi.
+    + rewrite itree_eta'. constructor; auto with itree. eapply CIH; eauto. step. rewrite H0. constructor. auto.
+    + rewrite itree_eta'. unpriv_pi. eapply CIH; eauto. apply H1. step. rewrite H0. constructor; auto.
+  - inv Hsec; eauto with itree.
+    + constructor. eapply CIH; eauto with itree. step. rewrite H0. constructor; auto. now step in REL.
+    + unpriv_pi. eapply CIH; eauto. apply H1.
+    + unpriv_pi. eapply CIH. apply H1. step. rewrite H0. apply EqTauL; auto. now step in REL.
   - inv Hsec.
-    + pclearbot. rewrite itree_eta'. constructor; auto. right. eapply CIH; eauto.
-      pfold. red. rewrite H0. constructor. left. auto.
-    + ddestruction. subst. constructor; auto with itree. right.
-      pclearbot. eapply CIH; eauto with itree. apply H1.
-    + ddestruction. subst. unpriv_pi. right. pclearbot.
-      eapply CIH; eauto with itree. apply H1.
-    + ddestruction. subst. unpriv_pi. right. pclearbot.
-      eapply CIH; eauto with itree. apply H1.
-    + pclearbot. remember (VisF e k2) as ovis. rewrite itree_eta'.
-      unpriv_pi. rewrite Heqovis. right. eapply CIH; eauto with itree. apply H1.
-      pfold. red. rewrite H0. constructor. left. auto.
-    + ddestruction. subst. unpriv_pi. right. eapply CIH; eauto with itree. pclearbot. apply H1.
-  - eapply IHHeq; eauto. clear IHHeq. inv Hsec; pclearbot.
+    + rewrite itree_eta'. constructor; auto. eapply CIH; eauto. step. rewrite H0. apply EqVis. apply REL.
+    + ddestruction. subst. constructor; auto with itree. intros a. eapply CIH. apply H1. apply REL.
+    + ddestruction. subst. unpriv_pi. eapply CIH. apply H1. apply REL.
+    + ddestruction. subst. unpriv_pi. eapply CIH. apply H1. apply REL.
+    + remember (VisF e k2) as ovis. rewrite itree_eta'. unpriv_pi. rewrite Heqovis. eapply CIH. apply H1. step. rewrite H0. apply EqVis. apply REL.
+    + ddestruction. subst. unpriv_pi. eapply CIH. apply H1. apply REL.
+  - eapply IHHeq; eauto. clear IHHeq. inv Hsec.
     + constructor; auto.
-    + constructor; auto. left. apply pi_eqit_secure_mixed_trans_aux1. pfold. red.
-      rewrite <- H0. cbn. pstep_reverse.
-    + pstep_reverse.
+    + inv CHECK. constructor; auto. apply pi_eqit_secure_mixed_trans_aux1. step. rewrite <- H0. now step in H1.
+    + now step in H1.
     + unpriv_pi.
-    + unpriv_pi. left. apply pi_eqit_secure_mixed_trans_aux1. pfold. red.
-      rewrite <- H0. cbn. pstep_reverse.
-  - constructor; auto. left. pfold. eapply IHHeq; eauto.
+    + inv CHECK0. unpriv_pi. apply pi_eqit_secure_mixed_trans_aux1. step. rewrite <- H0. specialize (H1 a). step in H1. apply H1.
+  - constructor; auto. step. eapply IHHeq; eauto.
 Qed.
 
 Lemma pi_eqit_secure_RR_imp b1 b2 E R1 R2 (RR1 : R1 -> R2 -> Prop ) (RR2 : R1 -> R2 -> Prop)
@@ -230,199 +208,229 @@ Lemma pi_eqit_secure_RR_imp b1 b2 E R1 R2 (RR1 : R1 -> R2 -> Prop ) (RR2 : R1 ->
       pi_eqit_secure Label priv RR1 b1 b2 l t1 t2 ->
       pi_eqit_secure Label priv RR2 b1 b2 l t1 t2.
 Proof.
-  intro Himp. pcofix CIH.
-  intros. pfold. red. punfold H0. red in H0.
-  inv H0; eauto;
-  try (constructor; auto; pclearbot; eauto; fail);
-  try (pclearbot; constructor; auto; right; eapply CIH; eauto; try apply H2; fail).
-Qed.
-
-Lemma pi_eqit_secureC_wcompat_id :  forall b1 b2 E R1 R2 (RR : R1 -> R2 -> Prop )
-      Label priv l
-, wcompatible2 (@pi_secure_eqit_ E R1 R2 Label priv RR b1 b2 l id)
-                                         (eqitC RR b1 b2) .
-Proof.
-  econstructor. pmonauto_itree.
-  intros. destruct PR.
-  punfold EQVl. punfold EQVr. unfold_eqit. red in REL. red.
-  hinduction REL before r; intros; clear t1' t2'; try inv CHECK.
-  - genobs_clear t1 ot1. genobs_clear t2 ot2.
-    remember (RetF r1) as x.
-    hinduction EQVl before r; intros; inv Heqx; eauto.
-    + remember (RetF r3) as y.
-      hinduction EQVr before r; intros; inv Heqy; eauto with itree.
-      rewrite itree_eta' at 1. constructor; eauto with itree. gstep. red.
-      eapply IHEQVr; eauto.
-    + rewrite itree_eta'. constructor; auto. cbn. gstep. red. cbn.
-      eauto.
-  - remember (TauF t1) as y.
-    hinduction EQVl before r; intros; inv Heqy; try inv CHECK; subst; eauto.
-    + remember (TauF t2) as x.
-      hinduction EQVr before r; intros; inv Heqx; try inv CHECK; subst; eauto.
-      pclearbot. constructor. gclo. econstructor; eauto with paco.
-      pclearbot.
-      remember (TauF m1) as ot1. rewrite itree_eta' at 1.
-      constructor; auto. rewrite Heqot1. gstep. red. cbn. eauto.
-    + constructor; auto. gstep. red. eapply IHEQVl; eauto.
-  - inv EQVl; pclearbot; try inv CHECK.
-    + constructor; auto. gclo. econstructor; eauto with paco itree.
-    + constructor; auto. gclo. econstructor; eauto with paco itree.
-      apply eqit_inv_Tau_r. pfold. auto.
-  - inv EQVr; pclearbot; try inv CHECK.
-    + constructor; auto. gclo. econstructor; eauto with paco itree.
-    + constructor; auto. gclo. econstructor; eauto with paco itree.
-      apply eqit_inv_Tau_r. pfold. auto.
-  - remember (VisF e k1) as x.
-    hinduction EQVl before r; intros; inv Heqx; try inv CHECK; eauto.
-    + ddestruction. subst. remember (VisF e0 k3) as y.
-      hinduction EQVr before r; intros; inv Heqy; try inv CHECK; eauto.
-      * ddestruction. subst. constructor; auto.
-        intros. apply gpaco2_clo. pclearbot. econstructor; eauto with itree. apply H.
-      * pclearbot. remember (VisF e0 k1) as ovis. rewrite itree_eta' at 1.
-        constructor; auto. rewrite Heqovis. gstep. red. eapply IHEQVr; eauto with itree.
-    + constructor; auto. gstep. red. eapply IHEQVl; eauto.
-  - remember (VisF e k1) as x.
-    hinduction EQVl before r; intros; inv Heqx; try inv CHECK; subst; eauto.
-    + ddestruction. subst. pclearbot. remember (TauF t2) as y.
-      hinduction EQVr before r; intros; inv Heqy; try inv CHECK; subst; pclearbot; eauto.
-      * unpriv_pi. gclo. econstructor; cycle -1; eauto with paco itree. gfinal. left. apply H.
-      * remember (VisF e0 k1) as ovis. rewrite itree_eta' at 1. constructor; auto.
-        rewrite Heqovis. gstep. red. eapply IHEQVr; eauto.
-    + constructor; auto. gstep. red. eapply IHEQVl; eauto.
-  - remember (TauF t1) as x.
-    hinduction EQVl before r; intros; inv Heqx; try inv CHECK; subst; eauto.
-    + remember (VisF e k2) as y.
-      hinduction EQVr before r; intros; inv Heqy; try inv CHECK; subst; eauto.
-      * ddestruction. subst.
-        pclearbot. unpriv_pi. gclo. econstructor; cycle -1; eauto with paco itree.
-        gfinal. left. apply H.
-      * remember (TauF m1) as otm1. rewrite itree_eta' at 1. constructor; auto.
-        gstep. rewrite Heqotm1. red. eapply IHEQVr; eauto.
-   + constructor; auto. gstep. red. eapply IHEQVl; eauto.
-  - remember (VisF e1 k1) as x.
-    hinduction EQVl before r; intros; inv Heqx; try inv CHECK; subst; eauto.
-    + ddestruction. subst. remember (VisF e2 k3) as y.
-      hinduction EQVr before r; intros; inv Heqy; try inv CHECK; subst; eauto.
-      * ddestruction. subst. unpriv_pi. gclo. pclearbot.
-        econstructor; eauto with paco itree. gfinal. left. apply H.
-      * remember (VisF e1 k1) as ovis. rewrite itree_eta' at 1.
-        constructor; auto. rewrite Heqovis. gstep. eapply IHEQVr; eauto.
-    + remember (VisF e2 k2) as x.
-      hinduction EQVr before r; intros; inv Heqx; try inv CHECK; subst; eauto.
-      * ddestruction. subst. pclearbot. unpriv_pi.
-         gclo. eapply eqit_trans_clo_intro with (t1' := Vis e1 k0); eauto with paco itree.
-         gstep. red. cbn. unpriv_pi. gfinal. left. apply H.
-       * remember (TauF t3) as ott3. rewrite itree_eta' at 1. constructor; auto.
-         rewrite Heqott3. gstep. red. eapply IHEQVr; eauto.
-  - remember (VisF e k1) as x.
-    hinduction EQVl before r; intros; inv Heqx; try inv CHECK; eauto.
-    + ddestruction. subst. pclearbot. unpriv_pi.
-      gclo. econstructor; eauto with paco itree. gfinal. left. apply H.
-    + constructor; auto. gstep. eapply IHEQVl; eauto.
-  - remember (VisF e k2) as x.
-    hinduction EQVr before r; intros; inv Heqx; try inv CHECK; eauto.
-    + ddestruction. subst. pclearbot. unpriv_pi.
-      gclo. econstructor; eauto with paco itree. gfinal. left. apply H.
-    + constructor; auto. gstep. eapply IHEQVr; eauto.
+  intros Himp.
+  icoinduction c CIH. intros t1 t2 Ht12. step in Ht12.
+  hinduction Ht12 before c; intros; eauto with itree;
+  try ( constructor; auto; intros; eapply CIH; eauto; fail);
+  try ( unpriv_pi; intros; eapply CIH; eauto; apply H; fail).
+  constructor; auto. intros. eapply CIH. apply H.
 Qed.
 
-#[export] Hint Resolve pi_eqit_secureC_wcompat_id : paco.
-
-Global Instance geuttgen_cong_secure_eqit {E} {Label priv l} {R1 R2 : Type} {RR1 : R1 -> R1 -> Prop}
-    {RR2 : R2 -> R2 -> Prop} {RS : R1 -> R2 -> Prop} (b1 b2 : bool) {r rg} :
-    (forall (x x' : R1) (y : R2), (RR1 x x' : Prop) -> (RS x' y : Prop) -> RS x y) ->
-    (forall (x : R1) (y y' : R2), (RR2 y y' : Prop) -> RS x y' -> RS x y) ->
-    Proper (@eq_itree E R1 R1 RR1 ==> eq_itree RR2 ==> flip impl)
-           (gpaco2 (pi_secure_eqit_ Label priv RS b1 b2 l id) (eqitC RS b1 b2) r rg ).
+Ltac inv_eq_itree := 
+  repeat match goal with 
+  | [ H : eqitF _ false false _ (RetF _) _ |- _ ] => inv H
+  | [ H : eqitF _ false false _ _ (RetF _) |- _ ] => inv H
+  | [ H : eqitF _ false false _ (TauF _) _ |- _ ] => inv H
+  | [ H : eqitF _ false false _ _ (TauF _) |- _ ] => inv H
+  | [ H : eqitF _ false false _ (VisF _ _) _ |- _ ] => inv H
+  | [ H : eqitF _ false false _ _ (VisF _ _) |- _ ] => inv H
+  end. 
+
+#[local] Ltac taul ::= eapply pisecEqTauL; [auto|].
+#[local] Ltac taur ::= eapply pisecEqTauR; [auto|].
+
+(* #[global] Instance pi_eqit_secure_proper_secureC {E R1 R2}  Label priv (RR : R1 -> R2 -> Prop) l
+  (c : Chain (pi_secure_eqit_mon Label priv RR true true l)) :
+  Proper (euttge (E := E) eq ==> euttge eq ==> flip impl) (elem c).
+Proof with eauto with itree. 
+   unfold Proper, respectful, flip, impl.
+  tower induction.
+  clear c; intros c IH x x' EQx y y' EQy; step in EQx; step in EQy.
+    intros EQ. icbn; icbn in EQ. 
+    genobs x' ox'; genobs y' oy'.
+    (* [hinduction] is not sufficient here, because [move] is unable to pass
+         through [ox] to reach [x] *)
+    revert x x' y y' Heqox' Heqoy' EQx EQy.
+    induction EQ; intros.
+    + clear x' y' Heqox' Heqoy'.
+      genobs x ox.
+      genret r1 or1.
+      revert x Heqox.
+      hinduction EQx before ox; try easy.
+      * intros; subst; inv Heqor1. clear x Heqox.
+        genobs y oy; genret r2 or2.
+        revert y Heqoy.
+        hinduction EQy before oy; try easy.
+        subst; intros [=<-] ??...
+        intros. rewrite itree_eta' at 1; taur. step. eapply IHEQy; eauto. 
+      * intros; subst. taul. step. eapply IHEQx... 
+    + clear x' y' Heqox' Heqoy'.
+      genobs x ox.
+      gentau t1 om1.
+      revert x Heqox.
+      hinduction EQx before ox; try easy.
+      * intros [=<-] ? ??.
+        clear x Heqox.
+        genobs y oy; gentau t2 om2.
+        revert y Heqoy.
+        hinduction EQy before oy; try easy.
+        intros [=<-] ??...
+        intros. rewrite itree_eta' at 1.  
+        taur.
+        now step; eapply IHEQy.
+      * intros; subst; taul; step; eapply IHEQx...
+     + edestruct euttge_tau_r_inv; [step; eauto |].
+      simpobs.
+      taul.
+      eapply IH.
+      assert (euttge eq (Tau x0) (Tau t1)) by (now step).
+      eapply euttge_tau_inv; eauto. unstep in EQy. apply EQy. assumption. 
+
+    + edestruct euttge_tau_r_inv; [step; eauto |].
+      simpobs.
+      taur.
+      eapply IH. 
+      unstep in EQx. apply EQx. 
+      assert (euttge eq (Tau x0) (Tau t2)) by (now step).
+      eapply euttge_tau_inv; eauto.
+      assumption. 
+    + clear x' y' Heqox' Heqoy'.
+      genobs x ox.
+      genvis e k1 ot1.
+      revert x Heqox.
+      hinduction EQx before ox; try easy.
+      * intros.
+        apply eq_inv_VisF_weak in Heqot1 as (-> & ? & ?); cbn in *; subst.
+        clear x Heqox.
+        genobs y oy; genvis e k2 ot2.
+        revert y Heqoy.
+        hinduction EQy before oy; try easy.
+        intros; apply eq_inv_VisF_weak in Heqot2 as (-> & ? & ?); cbn in *; subst; eauto with itree.
+        intros.
+        rewrite itree_eta' at 1. taur.
+        now step; eapply IHEQy.
+      * intros; subst; taul; step; eapply IHEQx...
+     + clear x' y' Heqox' Heqoy'.
+      genobs x ox.
+      genvis e k1 ot1.
+      revert x Heqox.
+      hinduction EQx before ox; try easy.
+      * intros.
+        apply eq_inv_VisF_weak in Heqot1 as (-> & ? & ?); cbn in *; subst.
+        clear x Heqox.
+        genobs y oy; genvis e k0 ot2.
+        revert y Heqoy.  
+        remember (TauF t2).
+        hinduction EQy before oy; intros; subst; try easy.
+        -- inv Heqi. constructor 6; intros; auto.  eapply IH. apply REL. apply REL0. apply H.  
+        -- rewrite itree_eta' at 1. taur. 
+        step. eapply IHEQy; eauto. 
+      * intros; subst; taul; step; eapply IHEQx...
+    + clear x' y' Heqox' Heqoy'.
+      genobs y oy.
+      genvis e k2 ot2.
+      revert y Heqoy.
+      hinduction EQy before oy; try easy.
+      * intros.
+        apply eq_inv_VisF_weak in Heqot2 as (-> & ? & ?); cbn in *; subst.
+        clear y Heqoy.
+        genobs x ox; genvis e k1 ot2.
+        revert x Heqox.  
+        remember (TauF t1).
+        hinduction EQx before ox; intros; subst; try easy.
+        -- inv Heqi. constructor 7; intros; auto.  eapply IH. apply REL. apply REL0. apply H.  
+        -- rewrite itree_eta'. taul. 
+        step. eapply IHEQx; eauto. 
+      * intros; subst; taur; step; eapply IHEQy...
+    + 
+Qed.  *)
+
+#[global] Instance pi_eqit_secure_proper_secureC {E R1 R2} b1 b2 Label priv (RR : R1 -> R2 -> Prop) l
+  (c : Chain (pi_secure_eqit_mon Label priv RR b1 b2 l)) :
+  Proper (eq_itree (E := E) eq ==> eq_itree eq ==> flip impl) (elem c).
 Proof.
-  repeat intro. gclo. econstructor; eauto with itree.
-  - eapply eqit_mon, H1; eauto; discriminate.
-  - eapply eqit_mon, H2; eauto; discriminate.
-Qed.
-
-Global Instance geuttgen_cong_eq_secure_eqit {E} {Label priv l} {R1 R2 : Type} {RS : R1 -> R2 -> Prop} (b1 b2 : bool) {r rg} :
-    Proper (@eq_itree E R1 R1 eq ==> eq_itree eq ==> flip impl)
-           (gpaco2 (pi_secure_eqit_ Label priv RS b1 b2 l id) (eqitC RS b1 b2) r rg ).
+  do 5 red. tower induction. intros CIH t1 t2 H12 t3 t4 H34 Hpi.
+  icbn; icbn in Hpi. step in H12; step in H34. 
+  induction Hpi; inv_eq_itree.
+  (* ret and coinductive cases are simple *)
+  1,2: eauto with itree. 
+  - taul. eapply CIH. apply REL. step; apply H34. assumption. 
+  - taur. eapply CIH. step; apply H12. apply REL. assumption. 
+  - ddestruction. evis.  
+  - ddestruction. unpriv_pi. eapply CIH. apply REL0. apply REL. apply H. 
+  - ddestruction. unpriv_pi. eapply CIH. apply REL. apply REL0. apply H.
+  - ddestruction. unpriv_pi. eapply CIH. apply REL0. apply REL. apply H.
+  - ddestruction. unpriv_pi. eapply CIH. apply REL. step; apply H34. apply H. 
+  - ddestruction. unpriv_pi. eapply CIH. step; apply H12. apply REL. apply H.
+Qed. 
+
+
+#[global] Instance pi_eqit_secure_eq_itree_proper {E} {Label priv l} {R1 R2 : Type} {RS : R1 -> R2 -> Prop} (b1 b2 : bool) :
+   Proper (@eq_itree E R1 R1 eq ==> eq_itree eq ==> flip impl)
+          (pi_eqit_secure Label priv RS b1 b2 l).
 Proof.
-  eapply geuttgen_cong_secure_eqit; eauto; intros; subst; auto.
+  eapply pi_eqit_secure_proper_secureC with
+    (c := chain_gfp (pi_secure_eqit_mon Label priv RS b1 b2 l)).
 Qed.
 
-Global Instance pi_eqit_secure_eq_itree_proper {E} {Label priv l} {R1 R2 : Type} {RS : R1 -> R2 -> Prop} (b1 b2 : bool) :
+Global Instance pi_eqit_secure_eutt_proper {E} {Label priv l} {R1 R2 : Type} {RS : R1 -> R2 -> Prop} (b1 b2 : bool) :
    Proper (@eutt E R1 R1 eq ==> eutt eq ==> flip impl)
           (pi_eqit_secure Label priv RS true true l).
 Proof.
   intros t1 t2 Ht12 t3 t4 Ht34. intros Hsec.
   apply pi_eqit_secure_RR_imp with (RR1 := rcompose RS eq).
-  { intros. inv H. auto. }
-  eapply pi_eqit_secure_mixed_trans. 2: { symmetry in Ht34. apply Ht34. }
+  intros r0 r3 Hr; inv Hr; auto.
+  eapply pi_eqit_secure_mixed_trans; cycle 1.
+  symmetry in Ht34. apply Ht34.
   apply pi_eqit_secure_sym in Hsec. apply pi_eqit_secure_sym.
   symmetry in Ht12.
   apply pi_eqit_secure_RR_imp with (RR1 := rcompose (flip RS) eq).
-  { intros. inv H. auto. }
+  intros r0 r3 Hr; inv Hr; auto.
   eapply pi_eqit_secure_mixed_trans; eauto.
 Qed.
 
-Global Instance pi_eqit_secure_eutt_proper {E} {Label priv l} {R1 R2 : Type} {RS : R1 -> R2 -> Prop} (b1 b2 : bool) :
-   Proper (@eq_itree E R1 R1 eq ==> eq_itree eq ==> flip impl)
-          (pi_eqit_secure Label priv RS b1 b2 l).
-Proof.
-  repeat intro. ginit. rewrite H, H0. gfinal. eauto.
-Qed.
 
 Lemma pi_eqit_secure_ret E Label priv l b1 b2 R1 R2 (RR : R1 -> R2 -> Prop) r1 r2 :
   RR r1 r2 -> @pi_eqit_secure E R1 R2 Label priv RR b1 b2 l (Ret r1) (Ret r2).
 Proof.
-  intros; pfold; constructor; auto.
+  intros; step; constructor; auto.
 Qed.
 
 Lemma pi_eqit_secure_bind E Label priv l b1 b2 R1 R2 S1 S2 (RR : R1 -> R2 -> Prop) (RS : S1 -> S2 -> Prop) k1 k2 :
-  forall (t1 : itree E R1) (t2 : itree E R2),
-    (forall (r1 : R1) (r2 : R2), RR r1 r2 -> pi_eqit_secure Label priv RS b1 b2 l (k1 r1) (k2 r2) ) ->
+  forall (t1 : itree E R1) (t2 : itree E R2)
+  (c : Chain (pi_secure_eqit_mon Label priv RS b1 b2 l)),
+    (forall (r1 : R1) (r2 : R2), RR r1 r2 -> elem c (k1 r1) (k2 r2) ) ->
     pi_eqit_secure Label priv RR b1 b2 l t1 t2 ->
-    pi_eqit_secure Label priv RS b1 b2 l (ITree.bind t1 k1) (ITree.bind t2 k2).
+    elem c (ITree.bind t1 k1) (ITree.bind t2 k2).
 Proof.
-  ginit. gcofix CIH. intros. pinversion H1.
-  - apply simpobs in H. apply simpobs in H2. rewrite H. rewrite H2.
-    repeat rewrite bind_ret_l. gfinal. right. eapply paco2_mon; try apply H0; auto.
-    intros; contradiction.
-  - apply simpobs in H. apply simpobs in H2. rewrite H. rewrite H2.
-    repeat rewrite bind_tau. gstep. constructor. gfinal. left. eapply CIH; eauto.
-  - apply simpobs in H. apply simpobs in H2.  rewrite H2. rewrite H. rewrite bind_tau.
-    gstep. constructor; auto. gfinal. left. eapply CIH; eauto.
-    pfold. red. cbn. pstep_reverse.
-  - apply simpobs in H. apply simpobs in H2.  rewrite H2. rewrite H. rewrite bind_tau.
-    gstep. constructor; auto. gfinal. left. eapply CIH; eauto.
-    pfold. red. cbn. pstep_reverse.
-  - apply simpobs in H. apply simpobs in H2. rewrite H. rewrite H2.
-    repeat rewrite bind_vis. gstep. constructor; auto.
-    gfinal. left. eapply CIH; eauto. apply H3.
-  - apply simpobs in H. apply simpobs in H2. rewrite H. rewrite H2.
-    rewrite bind_vis. rewrite bind_tau. gstep. red. cbn. unpriv_pi.
-    gfinal. left. eapply CIH; eauto. apply H3.
-  - apply simpobs in H. apply simpobs in H2. rewrite H. rewrite H2.
-    rewrite bind_vis. rewrite bind_tau. gstep. red. cbn. unpriv_pi.
-    gfinal. left. eapply CIH; eauto. apply H3.
-  - apply simpobs in H. apply simpobs in H2. rewrite H. rewrite H2.
-    repeat rewrite bind_vis. gstep. red. cbn. unpriv_pi.
-    gfinal. left. eapply CIH; eauto. apply H3.
-  - apply simpobs in H. apply simpobs in H2. rewrite H. rewrite H2.
-    rewrite bind_vis. gstep. red. unpriv_pi.
-    gfinal. left. eapply CIH; eauto. pfold. red. cbn. pstep_reverse.
-  - apply simpobs in H. apply simpobs in H2. rewrite H. rewrite H2.
-    rewrite bind_vis. gstep. red. unpriv_pi.
-    gfinal. left. eapply CIH; eauto. pfold. red. cbn. pstep_reverse.
+  #[local] Ltac by_coinduction CIH := eapply CIH; intros; 
+                                      try solve [now simpobs_subst]; 
+                                      solve [now step; apply_foralls].
+  intros t1 t2 c. revert t1 t2. tower induction.
+  intros CIH t1 t2 Hk1k2 Ht1t2.
+  step in Ht1t2. genobs t1 ot1. genobs t2 ot2; icbn. 
+  hinduction Ht1t2 before c; intros. 
+  - rewrite 2 observe_bind. simpobs. now apply Hk1k2.
+  - rewrite 2 observe_bind. simpobs. etau. 
+    by_coinduction CIH. 
+  - rewrite observe_bind. simpobs. apply pisecEqTauL; auto.
+    by_coinduction CIH.
+  - rewrite (observe_bind t3). simpobs. etau. 
+    by_coinduction CIH. 
+  - rewrite 2 observe_bind. simpobs. apply piEqVisPriv; auto. intros a.
+    by_coinduction CIH. 
+  - rewrite 2 observe_bind. simpobs. apply piEqVisUnPrivTauLCo; auto. intros a.
+    by_coinduction CIH. 
+  - rewrite 2 observe_bind. simpobs. apply piEqVisUnPrivTauRCo; auto. intros a.
+    by_coinduction CIH. 
+  - rewrite 2 observe_bind. simpobs. apply piEqVisUnPrivVisCo; auto. intros a b.
+    by_coinduction CIH. 
+  - rewrite observe_bind. simpobs. apply piEqVisUnPrivLInd; auto. intros a.
+    by_coinduction CIH. 
+  - rewrite (observe_bind t2). simpobs. apply piEqVisUnPrivRInd; auto. intros a.
+    by_coinduction CIH. 
 Qed.
 
 Lemma pi_eqit_secure_iter_bind_aux:
   forall (E : Type -> Type) (B2 B1 A1 A2 : Type) (RA : A1 -> A2 -> Prop)
     (RB : B1 -> B2 -> Prop) (b1 b2 : bool) (Label : Preorder)
     (priv : forall A : Type, E A -> L) (l : L) (body1 : A1 -> itree E (A1 + B1))
-    (body2 : A2 -> itree E (A2 + B2)) (r : itree E B1 -> itree E B2 -> Prop),
-    (forall (a1 : A1) (a2 : A2), RA a1 a2 -> r (ITree.iter body1 a1) (ITree.iter body2 a2)) ->
+    (body2 : A2 -> itree E (A2 + B2))
+    (c : Chain (pi_secure_eqit_mon Label priv RB b1 b2 l)),
+    (forall (a1 : A1) (a2 : A2), RA a1 a2 -> elem c (ITree.iter body1 a1) (ITree.iter body2 a2)) ->
     forall (t1 : itree E (A1 + B1)) (t2 : itree E (A2 + B2)),
-      paco2 (pi_secure_eqit_ Label priv (HeterogeneousRelations.sum_rel RA RB) b1 b2 l id) bot2 t1
-            t2 ->
-      gpaco2 (pi_secure_eqit_ Label priv RB b1 b2 l id) (eqitC RB b1 b2) r r
+      pi_eqit_secure Label priv (HeterogeneousRelations.sum_rel RA RB) b1 b2 l t1 t2 ->
+      elem c
              (ITree.bind t1
                          (fun lr : A1 + B1 =>
                             match lr with
@@ -436,69 +444,68 @@ Lemma pi_eqit_secure_iter_bind_aux:
                             | inr r0 => Ret r0
                             end)).
 Proof.
-  intros E B2 B1 A1 A2 RA RB b1 b2 Label priv l body1 body2 r CIH t1 t2 H2.
-  generalize dependent t2. revert t1. gcofix CIH'. intros t1 t2 Ht12.
-  pinversion Ht12; apply simpobs in H; apply simpobs in H0.
-  - rewrite H, H0. repeat rewrite bind_ret_l. inv H1.
-    + gstep. constructor. gfinal. left. apply CIH'0. eapply CIH; eauto.
-    + gstep. constructor; auto.
-  - rewrite H, H0. repeat rewrite bind_tau. gstep. constructor.
-    gfinal. left. eapply CIH'; eauto.
-  - rewrite H. rewrite <- itree_eta in H0. rewrite H0. rewrite bind_tau. gstep.
-    constructor; auto. gfinal.
-    left. eapply CIH'; eauto.
-  - rewrite H0. rewrite <- itree_eta in H. rewrite H. rewrite bind_tau. gstep.
-    constructor; auto. gfinal.
-    left. eapply CIH'; eauto.
-  - rewrite H, H0. repeat rewrite bind_vis. gstep. constructor; auto.
-    intros. gfinal. left. eauto.
-  - rewrite H, H0. rewrite bind_vis, bind_tau.  gstep. unpriv_pi; auto.
-    intros. gfinal. left. eauto.
-  - rewrite H, H0. rewrite bind_vis, bind_tau.  gstep. unpriv_pi; auto.
-    intros. gfinal. left. eauto.
-  - rewrite H, H0. repeat rewrite bind_vis. gstep. unpriv_pi.
-    gfinal. left. eauto.
-  - rewrite H. rewrite <- itree_eta in H0. rewrite H0. rewrite bind_vis.
-    gstep. unpriv_pi. gfinal. left. eauto.
-  - rewrite H0. rewrite <- itree_eta in H. rewrite H. rewrite bind_vis.
-    gstep. unpriv_pi. gfinal. left. eauto.
-Qed.
+  intros E B2 B1 A1 A2 RA RB b1 b2 Label priv l body1 body2 c. 
+  tower induction. intros CIH Hbody t1 t2 Ht12. step in Ht12. 
+  icbn. genobs t1 ot1. genobs t2 ot2.
+  hinduction Ht12 before E; intros. 
+  #[local] Ltac break_observe := unfold observe; cbn; simpobs; cbn. 
+  (* QUESTION: why does 'now step; apply Hbody' instead of auto fail? *)
+  #[local] Ltac pi_solve CIH := constructor; auto; intros; by_coinduction CIH.
+  - break_observe. inv H; cbn; eauto with itree.
+    constructor. now step; apply Hbody. 
+  - break_observe. pi_solve CIH.
+  - unfold observe at 1; cbn; simpobs. pi_solve CIH.
+  - unfold observe at 2; cbn; simpobs. pi_solve CIH.
+  - break_observe. pi_solve CIH.
+  - break_observe. pi_solve CIH.
+  - break_observe. pi_solve CIH.
+  - break_observe. pi_solve CIH.
+  - unfold observe at 1; cbn; simpobs. pi_solve CIH.
+  - unfold observe at 2; cbn; simpobs. pi_solve CIH.
+Qed. 
+
 
 Lemma secure_eqit_iter E A1 A2 B1 B2 (RA : A1 -> A2 -> Prop) (RB : B1 -> B2 -> Prop)
                            b1 b2 Label priv l
                            (body1 : A1 -> itree E (A1 + B1) ) (body2 : A2 -> itree E (A2 + B2) ):
-  (forall a1 a2, RA a1 a2 -> pi_eqit_secure Label priv (HeterogeneousRelations.sum_rel RA RB) b1 b2 l (body1 a1) (body2 a2) ) ->
                            forall (a1 : A1) (a2 : A2), RA a1 a2 ->
+  (forall a1 a2, RA a1 a2 -> pi_eqit_secure Label priv (HeterogeneousRelations.sum_rel RA RB) b1 b2 l (body1 a1) (body2 a2) ) ->
     pi_eqit_secure Label priv RB b1 b2 l (ITree.iter body1 a1) (ITree.iter body2 a2).
 Proof.
-  intro Hbody. ginit. gcofix CIH. intros. rewrite unfold_iter. rewrite unfold_iter.
-  apply Hbody in H0. pinversion H0; apply simpobs in H; apply simpobs in H1.
-  - rewrite H. rewrite H1. repeat rewrite bind_ret_l. inv H2.
-    + gstep. constructor. gfinal. left. eapply CIH; eauto.
-    + gstep. constructor; auto.
-  - rewrite H. rewrite H1. repeat rewrite bind_tau. gstep.
-    constructor. eapply pi_eqit_secure_iter_bind_aux; eauto.
-  - rewrite H. rewrite bind_tau. gstep. constructor; auto.
-    eapply pi_eqit_secure_iter_bind_aux; eauto.
-    assert (t1 ≈ body1 a1).
-    { rewrite H. rewrite tau_eutt. reflexivity. }
-    inv CHECK. rewrite <- itree_eta in H1. rewrite H1. auto.
-  - rewrite H1. rewrite bind_tau. gstep. constructor; auto.
-    eapply pi_eqit_secure_iter_bind_aux; eauto. rewrite H.
-    rewrite <- itree_eta. apply H2.
-  - rewrite H, H1. repeat rewrite bind_vis. gstep. constructor; auto.
-    intros. red.
-    eapply pi_eqit_secure_iter_bind_aux; eauto.
-  - rewrite H, H1. rewrite bind_vis, bind_tau. gstep. unpriv_pi.
-    eapply pi_eqit_secure_iter_bind_aux; eauto.
-  - rewrite H, H1. rewrite bind_vis, bind_tau. gstep. unpriv_pi.
-    eapply pi_eqit_secure_iter_bind_aux; eauto.
-  - rewrite H, H1. repeat rewrite bind_vis. gstep. unpriv_pi.
-    eapply pi_eqit_secure_iter_bind_aux; eauto.
-  - rewrite H. rewrite bind_vis. gstep. unpriv_pi.
-    eapply pi_eqit_secure_iter_bind_aux; eauto.
-    rewrite H1. rewrite <- itree_eta. apply H2.
-  - rewrite H1. rewrite bind_vis. gstep. unpriv_pi. red.
-    rewrite H. rewrite <- itree_eta.
+  intros. rename H0 into Hbody. generalize dependent a2. revert a1.
+  icoinduction c CIH.
+  intros a1 a2 Ha. specialize (Hbody a1 a2 Ha) as Hbodya.
+  step in Hbodya.
+  remember (observe (body1 a1)).
+  remember (observe (body2 a2)).
+  hinduction Hbodya before E; intros; cbn; auto with itree.
+  - break_observe. inv H; cbn; eauto with itree. 
+  - break_observe. constructor. 
     eapply pi_eqit_secure_iter_bind_aux; eauto.
+    (* taul, taur hard *)
+  - unfold observe at 1; cbn; simpobs. constructor; auto. ITree.fold_subst.
+    rewrite unfold_iter. eapply pi_eqit_secure_iter_bind_aux; eauto. 
+    now simpobs_subst.   
+  - unfold observe at 2; cbn; simpobs. constructor; auto. ITree.fold_subst.
+    rewrite unfold_iter. eapply pi_eqit_secure_iter_bind_aux; eauto. 
+    now simpobs_subst.   
+  - break_observe. constructor; auto. intro. eapply pi_eqit_secure_iter_bind_aux; eauto. apply H. 
+  - break_observe. constructor; intros; auto. eapply pi_eqit_secure_iter_bind_aux; intros. 
+    apply CIH; eauto. apply H. 
+  - break_observe. constructor; intros; auto. eapply pi_eqit_secure_iter_bind_aux; eauto. 
+    apply H. 
+  - break_observe. constructor; intros; auto. eapply pi_eqit_secure_iter_bind_aux; eauto. 
+    apply H. 
+  - unfold observe at 1; cbn; simpobs; cbn. constructor; intros; auto. 
+    rewrite unfold_iter. 
+    eapply pi_eqit_secure_iter_bind_aux; eauto. now simpobs_subst. 
+  - unfold observe at 2; cbn; simpobs; cbn. constructor; intros; auto. 
+    rewrite unfold_iter. 
+    eapply pi_eqit_secure_iter_bind_aux; eauto. now simpobs_subst. 
+Qed. 
+
+Lemma secure_eqit_ret : forall (E : Type -> Type) Label priv l b1 b2 (R1 R2 : Type) (RR : R1 -> R2 -> Prop) (r1 : R1) (r2 : R2),
+    RR r1 r2 -> @eqit_secure E R1 R2 Label priv RR b1 b2 l (Ret r1) (Ret r2).
+Proof.
+  intros. step. constructor. auto.
 Qed.
diff --git a/extra/Secure/SecureEqProgInsensFacts.v b/extra/Secure/SecureEqProgInsensFacts.v
index d755c0ea..73fde621 100644
--- a/extra/Secure/SecureEqProgInsensFacts.v
+++ b/extra/Secure/SecureEqProgInsensFacts.v
@@ -1,3 +1,6 @@
+From Coinduction Require Import all.
+From Stdlib Require Import Morphisms Program.Basics.
+
 From ITree Require Import
      Axioms
      ITree
@@ -8,8 +11,6 @@ From ITree.Extra Require Import
      Secure.SecureEqProgInsens
 .
 
-From Paco Require Import paco.
-
 Import Monads.
 Import MonadNotation.
 Local Open Scope monad_scope.
@@ -18,71 +19,7 @@ Variant case_rel {A1 A2 B : Type} (R1 : A1 -> B -> Prop) (R2 : A2 -> B -> Prop)
   | crl a1 b : R1 a1 b -> case_rel R1 R2 (inl a1) b
   | crr a2 b : R2 a2 b -> case_rel R1 R2 (inr a2) b.
 
-Lemma pi_eqit_secure_iter_ret E R S1 S2 Label priv l b2 s body
-      (Rinv : R -> S2 -> Prop) (RS : S1 -> S2 -> Prop)
-  (HRinv : (forall r', Rinv r' s ->
-            pi_eqit_secure Label priv (case_rel Rinv RS) true b2 l (body r') (Ret s) )) :
-  forall r,
-  Rinv r s ->
-  @pi_eqit_secure E S1 S2 Label priv RS true b2 l (ITree.iter body r) (Ret s).
-Proof.
-  ginit. gcofix CIH. intros r0 Hr0. setoid_rewrite unfold_iter.
-  assert (pi_eqit_secure Label priv (case_rel Rinv RS) true b2 l (body r0) (Ret s)).
-  auto. remember (body r0) as t. clear Heqt. generalize dependent t.
-  gcofix CIH'. intros t Ht.
-  destruct (observe t) eqn : Heq; symmetry in Heq; apply simpobs in Heq.
-  - rewrite Heq.
-    assert (pi_eqit_secure Label priv (case_rel Rinv RS) true b2 l (Ret r1) (Ret s) ).
-    rewrite <- Heq. auto.
-    pinversion H. subst. inv H2.
-    + rewrite bind_ret_l. gstep. constructor; auto.
-      gfinal. left. eapply CIH; eauto.
-    + rewrite bind_ret_l. gstep. constructor. auto.
-  - rewrite Heq. rewrite bind_tau. gstep. constructor; auto.
-    gfinal. left. eapply CIH'.
-    assert (pi_eqit_secure Label priv (case_rel Rinv RS) true b2 l (Tau t0) (Ret s)).
-    rewrite <- Heq. auto. pinversion H. rewrite <- itree_eta. auto.
-  - destruct (classic (leq (priv _ e) l ) ).
-    + exfalso. apply HRinv in Hr0.
-      assert (pi_eqit_secure Label priv (case_rel Rinv RS) true b2 l (Vis e k) (Ret s) ).
-      { rewrite <- Heq. auto. }
-      pinversion H0; subst. ddestruction. subst. contradiction.
-    + rewrite Heq. rewrite bind_vis.
-      gstep. constructor; auto. intros x. gfinal. left. eapply CIH'.
-      assert ( pi_eqit_secure Label priv (case_rel Rinv RS) true b2 l (Vis e k) (Ret s)) .
-      rewrite <- Heq. auto. pinversion H0; subst; ddestruction; subst.
-      rewrite <- itree_eta. apply H2.
-Qed.
-
-Ltac use_simpobs :=
-  repeat match goal with
-         | H : TauF _ = observe ?t |- _ => apply simpobs in H
-         | H : RetF _ = observe ?t |- _ => apply simpobs in H
-         | H : VisF _ _ = observe ?t |- _ => apply simpobs in H
-  end.
-
-(* I believe we could generalize this lemma for any t2 that converges along all paths *)
-Lemma pi_eqit_secure_trans_ret E R1 R2 R3 Label priv l b1 b2
-      (RR1 : R1 -> R2 -> Prop) (RR2 : R2 -> R3 -> Prop)
-      (t1 : itree E R1) (r : R2) (t3 : itree E R3) :
-  pi_eqit_secure Label priv RR1 b1 b2 l t1 (Ret r) ->
-  pi_eqit_secure Label priv RR2 b1 b2 l (Ret r) t3 ->
-  pi_eqit_secure Label priv (rcompose RR1 RR2) b1 b2 l t1 t3.
-Proof.
-  revert t1 t3. ginit. gcofix CIH.
-  intros. pinversion H0; subst; try inv CHECK; use_simpobs.
-  - rewrite H. generalize dependent t3. gcofix CIH'. intros t3 Ht3.
-    pinversion Ht3; use_simpobs.
-    + rewrite H2. gstep. constructor; auto. econstructor; eauto.
-    + rewrite H2. gstep. constructor; auto. gfinal. left. eapply CIH'.
-      symmetry in H1. use_simpobs. rewrite H1 in H4. auto.
-    + rewrite H2. gstep. constructor; auto. intros. gfinal. left.
-      eapply CIH'. symmetry in H1. use_simpobs. setoid_rewrite H1 in H4. apply H4.
-  - symmetry in H2. use_simpobs. rewrite H. gstep. constructor; auto.
-    gfinal. left. eapply CIH; auto. rewrite <- H2. auto.
-  - symmetry in H2. use_simpobs. rewrite H. gstep. constructor; auto.
-    intros. gfinal. left. apply CIH; auto. rewrite <- H2. apply H3.
-Qed.
+(* ===== Vis lemmas ===== *)
 
 Lemma pi_eqit_secure_pub_vis E R1 R2 RR Label priv l b1 b2 A (e : E A)
       (k1 : A -> itree E R1) (k2 : A -> itree E R2) :
@@ -90,7 +27,7 @@ Lemma pi_eqit_secure_pub_vis E R1 R2 RR Label priv l b1 b2 A (e : E A)
   (forall a, pi_eqit_secure Label priv RR b1 b2 l (k1 a) (k2 a) ) ->
   pi_eqit_secure Label priv RR b1 b2 l (Vis e k1) (Vis e k2).
 Proof.
-  intros. pfold. constructor; auto. left. apply H0.
+  intros. step. constructor; auto.
 Qed.
 
 Lemma pi_eqit_secure_priv_vislr E R1 R2 RR Label priv l b1 b2 A B (e1 : E A) (e2 : E B)
@@ -99,7 +36,7 @@ Lemma pi_eqit_secure_priv_vislr E R1 R2 RR Label priv l b1 b2 A B (e1 : E A) (e2
   (forall a b, pi_eqit_secure Label priv RR b1 b2 l (k1 a) (k2 b) ) ->
   pi_eqit_secure Label priv RR b1 b2 l (Vis e1 k1) (Vis e2 k2).
 Proof.
-  intros. pfold. constructor; auto. left. apply H1.
+  intros. step. constructor; auto.
 Qed.
 
 Lemma pi_eqit_secure_priv_visl E R1 R2 RR Label priv l b2 A (e1 : E A)
@@ -108,7 +45,7 @@ Lemma pi_eqit_secure_priv_visl E R1 R2 RR Label priv l b2 A (e1 : E A)
   (forall a, pi_eqit_secure Label priv RR true b2 l (k1 a) t2 ) ->
   pi_eqit_secure Label priv RR true b2 l (Vis e1 k1) t2.
 Proof.
-  intros. pfold. constructor; auto. left. apply H0.
+  intros. step. constructor; auto.
 Qed.
 
 Lemma pi_eqit_secure_priv_visr E R1 R2 RR Label priv l b1 A (e1 : E A)
@@ -117,47 +54,132 @@ Lemma pi_eqit_secure_priv_visr E R1 R2 RR Label priv l b1 A (e1 : E A)
   (forall a, pi_eqit_secure Label priv RR b1 true l t1 (k2 a) ) ->
   pi_eqit_secure Label priv RR b1 true l t1 (Vis e1 k2).
 Proof.
-  intros. pfold. constructor; auto. left. apply H0.
+  intros. step. constructor; auto.
 Qed.
 
+(* ===== use_simpobs Ltac ===== *)
+
+Ltac use_simpobs :=
+  repeat match goal with
+         | H : TauF _ = observe ?t |- _ => apply simpobs in H
+         | H : RetF _ = observe ?t |- _ => apply simpobs in H
+         | H : VisF _ _ = observe ?t |- _ => apply simpobs in H
+  end.
+
+(* The [eq_itree]-based Proper in [SecureEqProgInsens.v] is [flip impl] only.
+   For [rewrite H] in the forward direction we need an [iff] (or [impl])
+   variant: derive it from the [flip impl] one using symmetry of [eq_itree]. *)
+#[global] Instance pi_eqit_secure_eq_itree_proper_iff
+  {E} {Label priv l} {R1 R2 : Type} {RS : R1 -> R2 -> Prop} (b1 b2 : bool) :
+  Proper (@eq_itree E R1 R1 eq ==> eq_itree eq ==> iff)
+         (pi_eqit_secure Label priv RS b1 b2 l).
+Proof.
+  intros t1 t1' EQ1 t2 t2' EQ2.
+  pose proof (pi_eqit_secure_eq_itree_proper (E := E) (RS := RS) (Label := Label)
+                (priv := priv) (l := l) b1 b2) as Hfwd.
+  unfold Proper, respectful in Hfwd.
+  split; intros H.
+  - (* P t1 t2 -> P t1' t2': use Proper with symmetric eqs *)
+    eapply (Hfwd _ _ (symmetry EQ1) _ _ (symmetry EQ2)). exact H.
+  - (* P t1' t2' -> P t1 t2: direct *)
+    eapply (Hfwd _ _ EQ1 _ _ EQ2). exact H.
+Qed.
+
+(* Iff variant on the chain element [elem c] (needed for forward rewrites
+   inside [coinduction c CIH] proofs). Derived from the [flip impl] chain
+   Proper [pi_eqit_secure_proper_secureC] in [SecureEqProgInsens.v]. *)
+#[global] Instance pi_eqit_secure_chain_proper_iff
+  {E R1 R2} b1 b2 Label priv (RR : R1 -> R2 -> Prop) l
+  (c : Chain (pi_secure_eqit_mon Label priv RR b1 b2 l)) :
+  Proper (@eq_itree E R1 R1 eq ==> eq_itree eq ==> iff) (elem c).
+Proof.
+  intros t1 t1' EQ1 t2 t2' EQ2.
+  pose proof (pi_eqit_secure_proper_secureC b1 b2 Label priv RR l c) as Hfwd.
+  unfold Proper, respectful in Hfwd.
+  split; intros H.
+  - eapply (Hfwd _ _ (symmetry EQ1) _ _ (symmetry EQ2)). exact H.
+  - eapply (Hfwd _ _ EQ1 _ _ EQ2). exact H.
+Qed.
+
+(* ===== Transitivity through Ret ===== *)
+
+(* I believe we could generalize this lemma for any t2 that converges along all paths *)
+Lemma pi_eqit_secure_trans_ret E R1 R2 R3 Label priv l b1 b2
+      (RR1 : R1 -> R2 -> Prop) (RR2 : R2 -> R3 -> Prop)
+      (t1 : itree E R1) (r : R2) (t3 : itree E R3) :
+  pi_eqit_secure Label priv RR1 b1 b2 l t1 (Ret r) ->
+  pi_eqit_secure Label priv RR2 b1 b2 l (Ret r) t3 ->
+  pi_eqit_secure Label priv (rcompose RR1 RR2) b1 b2 l t1 t3.
+Proof.
+  revert t1 t3. coinduction c CIH. 
+  intros. sinv H; subst; use_simpobs.
+  - step. rewrite H1. generalize dependent t3. icoinduction c' CIH'. intros t3 Ht3.
+  cbn. 
+    sinv Ht3; use_simpobs.
+    + constructor; auto. econstructor; eauto.
+    + rewrite itree_eta' at 1. constructor; auto. eapply CIH'.
+      symmetry in H. use_simpobs. now rewrite H in H2. 
+    + rewrite itree_eta' at 1. constructor; auto. intros.
+      eapply CIH'. symmetry in H. use_simpobs. setoid_rewrite H in H2. apply H2.
+  - symmetry in H2. use_simpobs. rewrite H1. constructor; auto.
+    eapply CIH; auto. rewrite <- H2. auto.
+  - symmetry in H2. use_simpobs. rewrite H1. constructor; auto.
+    intros. apply CIH; auto. rewrite <- H2. apply H3.
+Qed.
+
+(* ===== Iter through Ret ===== *)
+
+Lemma pi_eqit_secure_iter_ret E R S1 S2 Label priv l b2 s body
+      (Rinv : R -> S2 -> Prop) (RS : S1 -> S2 -> Prop)
+  (HRinv : (forall r', Rinv r' s ->
+            pi_eqit_secure Label priv (case_rel Rinv RS) true b2 l (body r') (Ret s) )) :
+  forall r,
+  Rinv r s ->
+  @pi_eqit_secure E S1 S2 Label priv RS true b2 l (ITree.iter body r) (Ret s).
+Proof.
+  coinduction. intros r0 Hr0. setoid_rewrite unfold_iter.
+  assert (pi_eqit_secure Label priv (case_rel Rinv RS) true b2 l (body r0) (Ret s))
+  by auto. 
+  remember (body r0) as t. clear Heqt. step. generalize dependent t.
+  coinduction c' CIH'. intros t Ht.
+  destruct (observe t) eqn : Heq; symmetry in Heq; apply simpobs in Heq.
+  - rewrite Heq.
+    assert (pi_eqit_secure Label priv (case_rel Rinv RS) true b2 l (Ret r) (Ret s) )
+    by now 
+    rewrite <- Heq.
+    sinv H. subst. inv H2.
+    + rewrite bind_ret_l. constructor; auto.
+      rewrite unfold_iter. eapply CIH'; eauto.
+    + rewrite bind_ret_l. constructor. auto.
+  - rewrite Heq. rewrite bind_tau. constructor; auto.
+    eapply CIH'.
+    assert (pi_eqit_secure Label priv (case_rel Rinv RS) true b2 l (Tau t0) (Ret s)).
+    rewrite <- Heq. auto. sinv H. rewrite <- itree_eta. auto.
+  - destruct (classic (leq (priv _ e) l ) ).
+    + exfalso. apply HRinv in Hr0.
+      assert (pi_eqit_secure Label priv (case_rel Rinv RS) true b2 l (Vis e k) (Ret s) ).
+      { rewrite <- Heq. auto. }
+      sinv H0; subst. ddestruction. subst. contradiction.
+    + rewrite Heq. rewrite bind_vis.
+      constructor; auto. intros x. eapply CIH'.
+      assert ( pi_eqit_secure Label priv (case_rel Rinv RS) true b2 l (Vis e k) (Ret s)) .
+      rewrite <- Heq. auto. sinv H0; subst; ddestruction; subst.
+      rewrite <- itree_eta. apply H2.
+Qed.
+
+(* ===== Bind compatibility =====
+
+    This is already proved of the chain; here just instantiated at the gfp.  *)
 Lemma pi_secure_eqit_bind'
      : forall (E : Type -> Type) (R1 R2 S1 S2 : Type) (RR : R1 -> R2 -> Prop)
          (RS : S1 -> S2 -> Prop) (b1 b2 : bool) (Label : Preorder)
          (priv : forall A : Type, E A -> L) (l : L)
-         r
          (t1 : itree E R1) (t2 : itree E R2) (k1 : R1 -> itree E S1)
          (k2 : R2 -> itree E S2),
        (forall (r1 : R1) (r2 : R2),
-        RR r1 r2 -> paco2 (pi_secure_eqit_ Label priv RS b1 b2 l id) r (k1 r1) (k2 r2)) ->
+        RR r1 r2 -> pi_eqit_secure Label priv RS b1 b2 l (k1 r1) (k2 r2)) ->
        pi_eqit_secure Label priv RR b1 b2 l t1 t2 ->
-       gpaco2 (pi_secure_eqit_ Label priv RS b1 b2 l id) (eqitC RS b1 b2) bot2 r
-              (ITree.bind t1 k1) (ITree.bind t2 k2).
+       pi_eqit_secure Label priv RS b1 b2 l (ITree.bind t1 k1) (ITree.bind t2 k2).
 Proof.
-  intros. revert H0. generalize dependent t2. generalize dependent t1.
-  gcofix CIH. intros t1 t2 Ht12.
-  pinversion Ht12; use_simpobs.
-  - rewrite H0, H1. repeat rewrite bind_ret_l. gfinal. right. eapply paco2_mon; try apply CIH0.
-    auto.
-  - rewrite H0, H1. repeat rewrite bind_tau. gstep. constructor. gfinal. left. eapply CIH.
-    auto.
-  - rewrite H0. rewrite bind_tau. gstep. constructor; auto.
-    gfinal. left. eapply CIH. apply simpobs in H1. rewrite <- itree_eta in H1.
-    rewrite H1. auto.
-  - rewrite H1. rewrite bind_tau. gstep. constructor; auto.
-    gfinal. left. eapply CIH. apply simpobs in H0. rewrite <- itree_eta in H0.
-    rewrite H0. auto.
-  - rewrite H0, H1. repeat rewrite bind_vis. gstep. constructor; auto.
-    intros. gfinal. left. eapply CIH; eauto. apply H2.
-  - rewrite H0, H1. rewrite bind_vis, bind_tau. gstep. red. cbn. unpriv_pi.
-    gfinal. left. eapply CIH; eauto. apply H2.
-  - rewrite H0, H1. rewrite bind_vis, bind_tau. gstep. red. cbn. unpriv_pi.
-    gfinal. left. eapply CIH; eauto. apply H2.
-  - rewrite H0, H1. repeat rewrite bind_vis. gstep. red. cbn. unpriv_pi.
-    gfinal. left. eapply CIH. apply H2.
-  - rewrite H0. rewrite bind_vis. gstep. constructor; auto. gfinal.
-    left. eapply CIH. apply simpobs in H1. rewrite <- itree_eta in H1. rewrite H1.
-    apply H2.
-  - rewrite H1. rewrite bind_vis. gstep. constructor; auto. gfinal.
-    left. eapply CIH. apply simpobs in H0. rewrite <- itree_eta in H0. rewrite H0.
-    apply H2.
+  intros. eapply pi_eqit_secure_bind; eauto.
 Qed.
diff --git a/extra/Secure/SecureEqWcompat.v b/extra/Secure/SecureEqWcompat.v
index ddf6908d..04a0c9b2 100644
--- a/extra/Secure/SecureEqWcompat.v
+++ b/extra/Secure/SecureEqWcompat.v
@@ -1,5 +1,19 @@
-From Coq Require Import Morphisms.
+(* Chain-based congruence for [eqit_secure].
 
+   This currently exports:
+
+   - The Ltac utilities used by downstream files
+     ([inv_vis_secure], [clear_trivial], [find_size], [produce_elem], [spew]).
+   - The small helper [eqit_secure_shalt_refl].
+   - A chain-level [Proper] instance [eqit_secure_proper_chain] for rewriting
+     under [eqit_secure ... eq] on either side of [elem c]. 
+
+   At the gfp level, [SecureEqEuttHalt.v] already provides:
+   - [proper_eqit_secure_eqit] — rewrite under [eqit b b eq] (eq_itree / eutt).
+   - [proper_eqit_secure_eqit_secure] — rewrite under [eqit_secure ... eq]. *)
+
+From Stdlib Require Import Morphisms Program.Basics.
+From Coinduction Require Import all.
 From ITree Require Import
      Axioms
      ITree
@@ -7,155 +21,28 @@ From ITree Require Import
 
 From ITree.Extra Require Import
      Secure.SecureEqHalt
-.
-
-From Paco Require Import paco.
+     Secure.SecureEqEuttHalt.
 
 Import Monads.
 Import MonadNotation.
 Local Open Scope monad_scope.
 
 
-Lemma eqit_secureC_wcompat_id :  forall b1 b2 E R1 R2 (RR : R1 -> R2 -> Prop )
-      Label priv l
-, wcompatible2 (@secure_eqit_ E R1 R2 Label priv RR b1 b2 l id)
-                                         (eqitC RR b1 b2) .
-Proof.
-  econstructor. pmonauto_itree.
-  intros. destruct PR.
-  punfold EQVl. punfold EQVr. unfold_eqit. red in REL. red.
-  hinduction REL before r; intros; clear t1' t2'; try inv CHECK.
-  - genobs_clear t1 ot1. genobs_clear t2 ot2.
-    remember (RetF r1) as x.
-    hinduction EQVl before r; intros; inv Heqx; eauto with itree.
-    remember (RetF r3) as y.
-    hinduction EQVr before r; intros; inv Heqy; eauto with itree.
-  - remember (TauF t1) as y.
-    hinduction EQVl before r; intros; inv Heqy; try inv CHECK; subst; eauto with itree.
-    remember (TauF t2) as x.
-    hinduction EQVr before r; intros; inv Heqx; try inv CHECK; subst; eauto with itree.
-    pclearbot. constructor. gclo. econstructor; eauto with paco.
-  - eapply IHREL; eauto.
-    remember (TauF t1) as x.
-    hinduction EQVl before r; intros; inv Heqx; try inv CHECK; eauto with itree.
-    constructor; auto. pclearbot. pstep_reverse.
-  - eapply IHREL; eauto.
-    remember (TauF t2) as x.
-    hinduction EQVr before r; intros; inv Heqx; try inv CHECK; eauto with itree.
-    constructor; auto. pclearbot. pstep_reverse.
-  - remember (VisF e k1) as x.
-    hinduction EQVl before r; intros; inv Heqx; try inv CHECK; eauto with itree.
-    ddestruction. subst. remember (VisF e0 k3) as y.
-    hinduction EQVr before r; intros; inv Heqy; try inv CHECK; eauto with itree.
-    ddestruction. subst. constructor; auto.
-    intros. apply gpaco2_clo. pclearbot. econstructor; eauto with itree. apply H.
-  - remember (VisF e k1) as x.
-    hinduction EQVl before r; intros; inv Heqx; try inv CHECK; subst; eauto with itree.
-    ddestruction. subst. pclearbot. remember (TauF t2) as y.
-    hinduction EQVr before r; intros; inv Heqy; try inv CHECK; subst; eauto with itree.
-    pclearbot.
-    unpriv_co. gclo. econstructor; eauto with paco itree. gfinal.
-    left. apply H.
-  - remember (TauF t1) as x.
-    hinduction EQVl before r; intros; inv Heqx; try inv CHECK; subst; eauto with itree.
-    remember (VisF e k2) as y.
-    hinduction EQVr before r; intros; inv Heqy; try inv CHECK; subst; eauto with itree.
-    ddestruction. subst.
-    pclearbot. unpriv_co. gclo. econstructor; eauto with paco itree.
-    gfinal. left. apply H.
-  - remember (VisF e1 k1) as x.
-    hinduction EQVl before r; intros; inv Heqx; try inv CHECK; subst; eauto with itree.
-    ddestruction. subst. remember (VisF e2 k3) as y.
-    hinduction EQVr before r; intros; inv Heqy; try inv CHECK; subst; eauto with itree.
-    ddestruction. subst. unpriv_co. gclo. pclearbot.
-    econstructor; eauto with itree paco. gfinal. left. apply H.
-  - remember (VisF e k1) as x.
-    hinduction EQVl before r; intros; inv Heqx; try inv CHECK; eauto with itree.
-    ddestruction. subst. pclearbot. unpriv_ind.
-    eapply H0; eauto. pstep_reverse.
-  - remember (VisF e k2) as x.
-    hinduction EQVr before r; intros; inv Heqx; try inv CHECK; eauto with itree.
-    ddestruction. subst. pclearbot. unpriv_ind.
-    eapply H0; eauto. pstep_reverse.
-  - remember (VisF e k1) as x.
-    hinduction EQVl before r; intros; inv Heqx; try inv CHECK; eauto with itree.
-    ddestruction. subst. remember (TauF t2) as y.
-    hinduction EQVr before r; intros; inv Heqy; try inv CHECK; eauto with itree.
-    pclearbot. unpriv_halt. gclo. econstructor; eauto with paco.
-    pfold. constructor. red; auto.
-  - remember (VisF e k2) as x.
-    hinduction EQVr before r; intros; inv Heqx; try inv CHECK; eauto with itree.
-    ddestruction. subst. remember (TauF t1) as y.
-    hinduction EQVl before r; intros; inv Heqy; try inv CHECK; eauto with itree.
-    pclearbot. unpriv_halt. gclo. econstructor; eauto with paco.
-    pfold. constructor. red; auto.
-  - remember (VisF e1 k1) as x.
-    hinduction EQVl before r; intros; inv Heqx; try inv CHECK; try contra_size; eauto with itree.
-    ddestruction. subst. remember (VisF e2 k3) as y.
-    hinduction EQVr before r; intros; inv Heqy; try inv CHECK; eauto with itree.
-    ddestruction. subst. unpriv_halt. pclearbot.
-    gclo. econstructor 1 with (t1' := Vis e1 k0); eauto with paco itree.
-    + pfold. constructor; left; auto.
-    + gfinal. left. apply H.
-  - remember (VisF e1 k1) as x.
-    hinduction EQVl before r; intros; inv Heqx; try inv CHECK; try contra_size; eauto with itree.
-    ddestruction. subst. remember (VisF e2 k3) as y.
-    hinduction EQVr before r; intros; inv Heqy; try inv CHECK; eauto with itree.
-    ddestruction. subst. unpriv_halt. pclearbot.
-    gclo. econstructor 1 with (t2' := Vis e2 k4); eauto with paco itree.
-    + pfold. constructor. left. auto.
-    + gfinal. left. apply H.
-Qed.
-
-#[export] Hint Resolve eqit_secureC_mon : paco.
-
 Lemma eqit_secure_shalt_refl : forall E R1 R2 b1 b2 (RR : R1 -> R2 -> Prop) Label priv l A (e : E A) k1 k2,
     (~ leq (priv _ e) l) -> empty A ->
     eqit_secure Label priv RR b1 b2 l (Vis e k1) (Vis e k2).
 Proof.
-  intros. pfold. red. cbn. unpriv_halt. contra_size.
+  intros. step. cbn. unpriv_halt. contra_size.
 Qed.
 
-Ltac inv_vis_secure := ddestruction; subst;
+(* ===== Generic Ltac utilities (also used by downstream files) ===== *)
+
+Ltac inv_vis_secure := ddestruction;
    try contradiction; try contra_size.
+
 Ltac clear_trivial :=
   repeat match goal with
   | H : empty ?A, H' : forall a : ?A, ?P |- _ => clear H' end.
-Ltac eqit_secureC_halt_cases E := repeat (pclearbot; clear_trivial; match goal with
-     | |- _ (TauF _ ) (TauF _) => constructor; gclo; pclearbot
-     | |- eqit_secureC ?RR ?Label ?priv ?l ?b1 ?b2 _ ?t1 ?t2 => econstructor; clear_trivial; eauto with paco
-     | H : secure_eqitF ?Label ?priv ?RR ?b1 ?b2 ?l _ _ (observe ?t1) _ |- eqit_secure ?Label ?priv ?RR ?b1 ?b2 ?l ?t1 ?t2 => pfold; eauto with itree
-     |  H : nonempty ?A |- _ _ (@VisF _ _ _ ?A ?e _ ) => unpriv_co; gclo ; pclearbot
-     |  H : nonempty ?A |- _  (@VisF _ _ _ ?A ?e _ ) _ => unpriv_co; gclo ; pclearbot
-     |  H : empty ?A |- _ _ (@VisF _ _ _ ?A ?e _ ) => unpriv_halt; gclo ; pclearbot
-     |  H : empty ?A |- _ (@VisF _ _ _ ?A ?e _ ) _ => unpriv_halt; gclo ; pclearbot
-     | |- eqit_secureC ?RR ?Label ?priv ?l ?b1 ?b2 _ ?t1 ?t2 => econstructor; eauto with paco
-
-     | H : forall a, secure_eqitF ?Label ?priv ?RR ?b1 ?b2 ?l _ _ _ (observe ?t2),
-       H1 : observe ?t2 = VisF ?e ?k |- eqit_secure _ _ _ _ _ _ _ (Vis ?e ?k) =>
-       rewrite H1 in H; pfold; apply H
-     |  HA : empty ?A, HB : empty ?B, ev1 : E ?A |-
-                       eqit_secure _ _ _ _ _ _ (go (@VisF _ _ _ ?A _ _ )) (go (@VisF _ _ _ ?B _ _ ))
-                       => pfold; red; cbn; unpriv_halt; try contra_size
-     |  H : forall a : ?A, paco2 _ bot2 (?k a) ?t |- eqit_secure _ _ _ _ _ _ (?k ?a) (?t)  => red; eauto with itree
-     |  H : forall a : ?A, paco2 _ bot2 ?t (?k a) |- eqit_secure _ _ _ _ _ _ ?t (?k ?a)   => red; eauto with itree
-     |  H : forall (a : ?A) (b : ?B), paco2 _ bot2 (?k1 a) (?k2 b) |-
-                                                                        eqit_secure _ _ _ _ _ _ (?k1 ?a) (?k2 ?b)   => red; eauto with itree
-     | H : _ (observe ?t) (VisF ?e1 ?k1) |- _ ?t ?t1 => rewrite itree_eta' in H; apply H
-     | a : ?A, H : empty ?A |- _ => contra_size
-     | a : ?A |- nonempty ?A => constructor; auto
-     | HA : empty ?A, HB : empty ?B, Heq : observe ?t = (@VisF _ _ _ ?A _ _)   |-
-         gpaco2 _ _ _ _ (?t ) (go (@VisF _ _ _ ?B _ _))  => gfinal; right; pstep; red; cbn; rewrite Heq; unpriv_halt
-     | HA : empty ?A, HB : empty ?B |-
-         gpaco2 _ _ _ _ (go (@VisF _ _ _ ?A _ _) ) (go (@VisF _ _ _ ?B _ _))  => gfinal; right; pstep; red; cbn; unpriv_halt
-     | H : forall (a : ?A), _ (observe (?k a) ) observe (?t), Heq : observe ?t = VisF ?e ?k1 |-
-        eqit_secure _ _ _ _ _ _ (?k ?a) _ => rewrite itree_eta' in Heq; rewrite Heq in H; pfold; apply H
-     | H : forall a : ?A, ?P (observe (?k a) ) (observe ?t), Heq : observe ?t = VisF ?e ?k2 |-
-                                                        eqit_secure _ _ _ _ _ _ (?k ?a) _ =>
-                                          rewrite itree_eta' in Heq; rewrite Heq in H; pfold; apply H
-  end;
-  clear_trivial)
-.
 
 Ltac find_size A :=
   match goal with
@@ -163,236 +50,245 @@ Ltac find_size A :=
   | H : empty A |- _ => idtac
   | |- _ => destruct (classic_empty A); try contra_size end.
 
-
 Ltac produce_elem H A := inv H; assert (nonempty A); try (constructor; auto with itree; fail).
 
-Ltac fold_secure :=
-  change (paco2 (_ ?LB ?priv ?RR ?b ?fls ?l _) ?a) with (eqit_secure LB priv RR b fls l) in *.
-
-(* Specialize some hypothesis with the assumption x *)
+(* Specialize every [forall _ : (type of x), _] hypothesis with [x]. *)
 Ltac spew x :=
   let T := type of x in
   repeat lazymatch goal with
   | [ H0 : forall (_ : T), _ |- _ ] => specialize (H0 x)
   end.
 
-Lemma eqit_secureC_wcompat_id' :  forall b1 b2 E R1 R2 (RR : R1 -> R2 -> Prop )
-      Label priv l,
-    wcompatible2 (@secure_eqit_ E R1 R2 Label priv RR b1 b2 l id)
-                                         (eqit_secureC RR Label priv l b1 b2) .
-Proof.
-  econstructor.
-  { red. intros. eauto with paco. }
-  intros. dependent destruction PR.
-  punfold EQVl. punfold EQVr. red in EQVl. red in EQVr. red in REL. red.
-  hinduction REL before r; intros; clear t1' t2'; try inv CHECK.
-  - remember (RetF r1) as x. hinduction EQVl before r; intros; subst; try inv Heqx; eauto with itree.
-    remember (RetF r3) as y. hinduction EQVr before r; intros; subst; try inv Heqy; eauto with itree.
-    rewrite itree_eta' at 1. unpriv_ind. eapply H0; eauto.
-  - remember (TauF t1) as x. hinduction EQVl before r; intros; subst; try inv Heqx;
-    try inv CHECK; eauto with itree.
-    + remember (TauF t4) as y. pclearbot.
-      (* think I might have a lead on the problem, should H0 have vclo not id here?*)
-      hinduction EQVr before r; intros; subst; try inv Heqy;
-      try inv CHECK; pclearbot; try fold_secure; eauto with itree.
-      * constructor. gclo. econstructor; eauto. gfinal; eauto.
-      * unpriv_co. gclo. econstructor; eauto. gfinal; eauto.
-      * rewrite itree_eta' at 1. unpriv_ind. eauto.
-      * unpriv_halt. gclo. econstructor; eauto. gfinal; eauto.
-    + remember (TauF t3) as y. pclearbot.
-      hinduction EQVr before r; intros; subst; try inv Heqy;
-      try inv CHECK; pclearbot; repeat fold_secure; eauto with itree.
-      * unpriv_co. gclo. econstructor; eauto. gfinal; eauto.
-      * unpriv_co. gclo. econstructor; eauto. gfinal; eauto.
-      * rewrite itree_eta' at 1. unpriv_ind. eauto.
-      * unpriv_halt. gclo. econstructor; eauto. gfinal; eauto.
-   + remember (TauF t3) as y. pclearbot.
-      hinduction EQVr before r; intros; subst; try inv Heqy;
-      try inv CHECK; pclearbot; repeat fold_secure; eauto with itree.
-      * unpriv_halt. gclo. econstructor; eauto. gfinal; eauto.
-      * unpriv_halt. gclo. econstructor; eauto. gfinal; eauto.
-      * rewrite itree_eta' at 1. unpriv_ind. eauto.
-      * unpriv_halt. contra_size.
- - eapply IHREL; eauto.
-   remember (TauF t1) as y. hinduction EQVl before r; intros; inv Heqy; try inv CHECK; eauto with itree.
-   + constructor; auto. pclearbot. pstep_reverse.
-   + unpriv_ind. pclearbot. pstep_reverse.
-   + pclearbot. punfold H.
- - eapply IHREL; eauto.
-   remember (TauF t2) as y. hinduction EQVr before r; intros; inv Heqy; try inv CHECL; eauto with itree.
-   + constructor; auto. pclearbot. pstep_reverse.
-   + unpriv_ind. pclearbot. pstep_reverse.
-   + pclearbot. punfold H.
- - remember (VisF e k1) as x.
-   hinduction EQVl before r; intros; inv Heqx; try inv CHECK; inv_vis_secure; eauto with itree.
-   remember (VisF e0 k3) as y.
-   hinduction EQVr before r; intros; inv Heqy; try inv CHECK; inv_vis_secure; eauto with itree.
-   + pclearbot. constructor; auto. intros. gclo. econstructor; eauto.
-     apply H0. apply H. gfinal; left; apply H1.
-   + rewrite itree_eta' at 1. unpriv_ind. eapply H0; eauto.
- - unfold id in H. remember (VisF e k1) as x.
-   hinduction EQVl before r; intros; inv Heqx; try inv CHECK; inv_vis_secure; eauto with itree.
-   + pclearbot. remember (TauF t2) as y.
-     hinduction EQVr before r; intros; inv Heqy; try inv CHECK; repeat fold_secure; eauto with itree.
-     * constructor. gclo. pclearbot. inv SIZECHECK. spew a. econstructor; eauto. gfinal; eauto.
-     * unpriv_co. gclo. pclearbot. inv SIZECHECK0. spew a0; spew a. econstructor; eauto.
-       gfinal; eauto.
-     * rewrite itree_eta' at 1. unpriv_ind. eauto.
-     * unpriv_halt. pclearbot. inv SIZECHECK0.
-       gclo. spew a. econstructor; eauto. gfinal; eauto.
-   + pclearbot. pclearbot. inv SIZECHECK. remember (TauF t2) as y.
-     hinduction EQVr before r; intros; inv Heqy; try inv CHECK; repeat fold_secure; eauto with itree.
-     * unpriv_co. gclo. pclearbot. spew a0. spew a. econstructor; eauto. gfinal; eauto.
-     * unpriv_co. gclo. pclearbot. fold_secure. spew a0; spew a. econstructor; eauto. gfinal; eauto.
-     * rewrite itree_eta' at 1. unpriv_ind. eauto.
-     * pclearbot. unpriv_halt. gclo. spew a0. spew a. econstructor; eauto. gfinal; eauto.
-  + pclearbot. inv SIZECHECK0. remember (TauF t2) as y.
-     hinduction EQVr before r; intros; inv Heqy; try inv CHECK; repeat fold_secure; eauto with itree.
-     * unpriv_halt. gclo. pclearbot. spew a; econstructor; eauto.
-       gfinal; eauto.
-     * unpriv_halt. gclo. pclearbot. fold_secure. spew a. econstructor; eauto. gfinal; eauto.
-     * rewrite itree_eta' at 1. unpriv_ind. eauto.
-     * pclearbot. unpriv_halt. contra_size.
- - unfold id in H. remember (VisF e k2) as x.
-   hinduction EQVr before r; intros; inv Heqx; try inv CHECK; inv_vis_secure; eauto with itree.
-   + pclearbot. remember (TauF t0) as y.
-     hinduction EQVl before r; intros; inv Heqy; try inv CHECK; eauto with itree; repeat fold_secure.
-     * constructor. gclo. pclearbot. fold_secure. inv SIZECHECK.
-       spew a; econstructor; eauto. gfinal; eauto.
-     * unpriv_co. gclo. pclearbot. fold_secure. inv SIZECHECK0. spew a; spew a0. econstructor; eauto.
-       gfinal; eauto.
-     * rewrite itree_eta'. unpriv_ind. eauto.
-     * unpriv_halt. pclearbot. inv SIZECHECK0.
-       gclo. spew a; econstructor; eauto. gfinal; eauto.
-   + pclearbot. pclearbot. inv SIZECHECK. remember (TauF t1) as y.
-     hinduction EQVl before r; intros; inv Heqy; try inv CHECK; repeat fold_secure; eauto with itree.
-     * unpriv_co. gclo. pclearbot. spew a0; spew a. econstructor; eauto. gfinal; eauto.
-     * unpriv_co. gclo. pclearbot. spew b; spew a; spew a0; econstructor; eauto.
-       gfinal; eauto.
-     * rewrite itree_eta'. unpriv_ind. eauto.
-     * pclearbot. unpriv_halt. gclo. spew a. econstructor; eauto. gfinal; eauto.
-  + pclearbot. inv SIZECHECK0. remember (TauF t1) as y.
-     hinduction EQVl before r; intros; inv Heqy; try inv CHECK; eauto with itree.
-     * unpriv_halt. gclo. pclearbot. fold_secure. spew a. econstructor; eauto.
-       gfinal; eauto.
-     * unpriv_halt. gclo. pclearbot. fold_secure. spew a. econstructor; eauto.
-       gfinal; eauto.
-     * rewrite itree_eta'. unpriv_ind. eauto.
-     * pclearbot. unpriv_halt. contra_size.
- - unfold id in H. remember (VisF e2 k2) as x.
-   hinduction EQVr before r; intros; inv Heqx; try inv CHECK; inv_vis_secure; eauto with itree; pclearbot; fold_secure.
-   1: inv SIZECHECK1; inv SIZECHECK2; remember (VisF e1 k1) as y.
-   2: inv SIZECHECK0; inv SIZECHECK3; remember (VisF e0 k0) as y.
-   3: inv SIZECHECK1; inv SIZECHECK2; remember (VisF e0 k0) as y.
-   all: spew a; spew a0.
-   all: hinduction EQVl before r; intros; inv Heqy; try inv CHECK; inv_vis_secure; subst;
-     eauto with itree; try (eqit_secureC_halt_cases E; fail).
-   all: rewrite itree_eta'; unpriv_ind; auto with itree; eauto.
- - inv SIZECHECK. eapply H0; eauto. Unshelve. all : auto.
-   remember (VisF e k1) as x. clear H0.
-   hinduction EQVl before r; intros; inv Heqx; inv_vis_secure; try inv CHECK; pclearbot; eauto with itree.
-   + constructor; auto. pstep_reverse.
-   + unpriv_ind. pstep_reverse.
-   + rewrite itree_eta' at 1 . pstep_reverse.
- - inv SIZECHECK. eapply (H0 a); eauto.
-   remember (VisF e k2) as x. clear H0.
-   hinduction EQVr before r; intros; inv Heqx; inv_vis_secure; try inv CHECK; pclearbot; eauto with itree.
-   + constructor; auto. pstep_reverse.
-   + unpriv_ind. pstep_reverse.
-   + rewrite itree_eta' at 1 . pstep_reverse.
- - remember (TauF t2) as x.
-   hinduction EQVr before r; intros; inv Heqx; try inv CHECK; pclearbot; eauto with itree;
-   inv EQVl; inv_vis_secure; eqit_secureC_halt_cases E.
-   + pclearbot. find_size A0; eqit_secureC_halt_cases E.
-   + pclearbot. find_size A1; eqit_secureC_halt_cases E.
- - remember (TauF t1) as x.
-   hinduction  EQVl before r; intros; inv Heqx; try inv CHECK; pclearbot; eauto with itree;
-   inv EQVr; inv_vis_secure;
-   eqit_secureC_halt_cases E.
-   + find_size A0; eqit_secureC_halt_cases E.
-   + find_size A1; eqit_secureC_halt_cases E.
- - unfold id in H. remember (VisF e2 k2) as x.
-   hinduction EQVr before r; intros; inv Heqx; try inv CHECK; inv_vis_secure;  pclearbot; eauto with itree;
-   inv EQVl; inv_vis_secure;
-   (* maybe I should just write a new one *)
-   do 2 (
-   repeat match goal with | H : nonempty ?A |- _ => inv H end;
-   match goal with
-   | e1 : E ?A, e2 : E ?B, e3 : E ?C, e4 : E ?D |- _ =>
-     find_size A ; find_size B; find_size C ; find_size D ; try contra_size
-   | e1 : E ?A, e2 : E ?B, e3 : E ?C |- _ =>
-     find_size A ; find_size B; find_size C ; try contra_size
-   | e1 : E ?A, e2 : E ?B |- _ =>
-      find_size A ; find_size B; try contra_size
-   | e1 : E ?A |- _ =>
-     find_size A ; try contra_size
-   end);
-   eqit_secureC_halt_cases E; try (eapply eqit_secure_shalt_refl; eauto); eqit_secureC_halt_cases E;
-   try apply H3; try apply H; eqit_secureC_halt_cases E.
-   Unshelve. all : auto.
- - unfold id in H. remember (VisF e1 k1) as x.
-   hinduction EQVl before r; intros; inv Heqx; try inv CHECK; inv_vis_secure; pclearbot; eauto with itree;
-     inv EQVr; inv_vis_secure;
-       do 2 (
-            repeat match goal with | H : nonempty ?A |- _ => inv H end;
-            match goal with
-            | e1 : E ?A, e2 : E ?B, e3 : E ?C, e4 : E ?D |- _ =>
-              find_size A ; find_size B; find_size C ; find_size D ; try contra_size
-            | e1 : E ?A, e2 : E ?B, e3 : E ?C |- _ =>
-              find_size A ; find_size B; find_size C ; try contra_size
-            | e1 : E ?A, e2 : E ?B |- _ =>
-              find_size A ; find_size B; try contra_size
-            | e1 : E ?A |- _ =>
-              find_size A ; try contra_size
-            end);
-       eqit_secureC_halt_cases E; try (eapply eqit_secure_shalt_refl; eauto); eqit_secureC_halt_cases E;
-   try apply H3; try apply H; eqit_secureC_halt_cases E.
-   Unshelve. all: auto.
-Qed.
+Ltac contra_leq :=
+  match goal with
+  | [ Hleq : leq ?a ?b, Hnleq : ~ leq ?a ?b |- _ ] => contradiction
+  end.
 
-#[export] Hint Resolve eqit_secureC_wcompat_id : paco.
+(* Decide the size of every event index appearing in the goal classically. *)
+Ltac resolve_sizes :=
+  repeat match goal with
+  | |- context [ @VisF _ _ _ ?A _ _ ] =>
+      lazymatch goal with
+      | _ : empty A |- _ => fail
+      | _ : nonempty A |- _ => fail
+      | _ => destruct (classic_empty A)
+      end
+  end;
+  try contra_size.
 
-#[global] Instance geuttgen_cong_secure_eqit {E} {Label priv l} {R1 R2 : Type} {RR1 : R1 -> R1 -> Prop}
-    {RR2 : R2 -> R2 -> Prop} {RS : R1 -> R2 -> Prop} (b1 b2 : bool) {r rg} :
-    (forall (x x' : R1) (y : R2), (RR1 x x' : Prop) -> (RS x' y : Prop) -> RS x y) ->
-    (forall (x : R1) (y y' : R2), (RR2 y y' : Prop) -> RS x y' -> RS x y) ->
-    Proper (@eq_itree E R1 R1 RR1 ==> eq_itree RR2 ==> flip impl)
-           (gpaco2 (secure_eqit_ Label priv RS b1 b2 l id) (eqitC RS b1 b2) r rg ).
-Proof.
-  repeat intro. gclo. econstructor; eauto.
-  - eapply eqit_mon, H1; eauto; discriminate.
-  - eapply eqit_mon, H2; eauto; discriminate.
-Qed.
+(* Close a halting [Vis]/[Vis] obligation, at either the [gfp]
+   ([eqit_secure]) or chain ([elem c]) level: step into the halting
+   constructor, then finish by the empty-index contradiction or the body
+   hypothesis.  More general than [eqit_secure_shalt_refl] (the two events
+   need not coincide). *)
+Ltac secure_halt_refl :=
+  solve [ step; cbn; unpriv_halt; intros;
+          repeat match goal with He : nonempty ?A |- _ =>
+                   let w := fresh "wit" in destruct He as [w] end;
+          first [ contra_size
+                | solve [ apply_foralls; eauto with itree ]
+                | solve [ eauto with itree ] ] ].
 
-#[global] Instance geuttgen_cong_secure_eqit' {E} {Label priv l} {R1 R2 : Type} {RR1 : R1 -> R1 -> Prop}
-    {RR2 : R2 -> R2 -> Prop} {RS : R1 -> R2 -> Prop} (b1 b2 : bool) {r rg} :
-    (forall (x x' : R1) (y : R2), (RR1 x x' : Prop) -> (RS x' y : Prop) -> RS x y) ->
-    (forall (x : R1) (y y' : R2), (RR2 y y' : Prop) -> RS x y' -> RS x y) ->
-    Proper (@eqit_secure E R1 R1 Label priv RR1 false false l ==>
-             eqit_secure Label priv RR2 false false l ==> flip impl)
-           (gpaco2 (secure_eqit_ Label priv RS b1 b2 l id) (eqit_secureC RS Label priv l b1 b2) r rg ).
-Proof.
-  repeat intro. gclo. econstructor; eauto.
-  - eapply secure_eqit_mon, H1; eauto. intros; discriminate.
-  - eapply secure_eqit_mon, H2; eauto. intros; discriminate.
-Qed.
+Ltac sec_hyp :=
+  first [ eassumption
+        | solve [ apply_foralls; first [ eassumption | eauto with itree ] ]
+        | solve [ eauto with itree ] ].
+
+Ltac sec_fin := solve [ sec_hyp | secure_halt_refl ].
+
+(* Deep halt/halt subcases: no hypothesis pins the [CIH] intermediate, but it
+   can be taken to be the concrete halting [Vis] already on the other side. *)
+Ltac sec_reflexive :=
+  match goal with
+  | |- eqit_secure _ _ _ _ _ _ ?X ?Y =>
+      first [ is_evar Y; unify Y X | is_evar X; unify X Y ]
+  end;
+  secure_halt_refl.
+
+(* [eapply CIH] leaves [eqit_secure x ?y], [eqit_secure x0 ?y0],
+   [elem c ?y ?y0].  Pin the shared evars from a concrete hypothesis before
+   any [secure_halt_refl] (running it on an evar goal would invent and shelve
+   a spurious event).  The body hypothesis (premise 3) or the [eqit_secure]
+   hypotheses (premises 1/2) provide the pinning; try both orders. *)
+Ltac by_coinduction CIH :=
+  first
+  [ (eapply CIH;
+     [ first [ sec_hyp | sec_reflexive ]
+     | first [ sec_hyp | sec_reflexive ]
+     | sec_fin ])
+  | (eapply CIH;
+     only 3: (solve [ eassumption | apply_foralls; eassumption ]);
+     sec_fin) ].
+
+(* ===== Smart constructor for [secure_eqitF] =====
+
+   [smart_constructor conclude] inspects the goal shape (Ret/Tau/Vis on each
+   side) and the context (for [leq]/[~ leq]/[nonempty]/[empty] facts), then
+   tries the [secure_eqitF] constructors that are compatible with that shape,
+   in a sensible order.  For each candidate it [eapply]s the constructor,
+   discharges the side-conditions ([SECCHECK]/[SIZECHECK]/[CHECK]) from the
+   context, and runs [conclude] on the remaining relational premise(s).  If
+   that whole sequence does not close the goal it backtracks and tries the
+   next constructor; if none work it leaves the goal untouched (never fails). *)
+
+(* Discharge one subgoal produced by a [secure_eqitF] constructor: trivial
+   side-conditions by [assumption]/[reflexivity]/[contra_size]/[auto]; the
+   relational premise(s) by [conclude] (after [intros]). *)
+Tactic Notation "sec_side" tactic3(conclude) :=
+  first [ assumption
+        | reflexivity
+        | contra_size
+        | solve [ econstructor; eassumption ]   (* [nonempty A] from a witness *)
+        | solve [ auto ]
+        | solve [ intros;
+                  repeat match goal with He : nonempty ?A |- _ =>
+                           let w := fresh "wit" in destruct He as [w] end;
+                  first [ contra_size | conclude ] ] ].
+
+Tactic Notation "smart_constructor" tactic3(conclude) :=
+  lazymatch goal with
+  | |- @secure_eqitF _ _ _ _ _ _ _ _ _ _ (RetF _) (RetF _) =>
+      first [ solve [ eapply secEqRet;             sec_side conclude ]
+            | fail 1 "smart_constructor: Ret/Ret unsolved" ]
+  | |- @secure_eqitF _ _ _ _ _ _ _ _ _ _ (TauF _) (TauF _) =>
+      first [ solve [ eapply secEqTau;             sec_side conclude ]
+            | solve [ eapply secEqTauL;            sec_side conclude ]
+            | solve [ eapply secEqTauR;            sec_side conclude ]
+            | fail 1 "smart_constructor: Tau/Tau unsolved" ]
+  | |- @secure_eqitF _ _ _ _ _ _ _ _ _ _ (VisF _ _) (VisF _ _) =>
+      first [ solve [ eapply EqVisPriv;            sec_side conclude ]
+            | solve [ eapply EqVisUnPrivVisCo;     sec_side conclude ]
+            | solve [ eapply EqVisUnprivHaltLVisR; sec_side conclude ]
+            | solve [ eapply EqVisUnprivHaltRVisL; sec_side conclude ]
+            | solve [ eapply EqVisUnPrivLInd;      sec_side conclude ]
+            | solve [ eapply EqVisUnPrivRInd;      sec_side conclude ]
+            | fail 1 "smart_constructor: Vis/Vis unsolved" ]
+  | |- @secure_eqitF _ _ _ _ _ _ _ _ _ _ (VisF _ _) (TauF _) =>
+      first [ solve [ eapply EqVisUnPrivTauLCo;    sec_side conclude ]
+            | solve [ eapply EqVisUnprivHaltLTauR; sec_side conclude ]
+            | solve [ eapply secEqTauR;            sec_side conclude ]
+            | solve [ eapply secEqTauL;            sec_side conclude ]
+            | solve [ eapply EqVisUnPrivLInd;      sec_side conclude ]
+            | fail 1 "smart_constructor: Vis/Tau unsolved" ]
+  | |- @secure_eqitF _ _ _ _ _ _ _ _ _ _ (TauF _) (VisF _ _) =>
+      first [ solve [ eapply EqVisUnPrivTauRCo;    sec_side conclude ]
+            | solve [ eapply EqVisUnprivHaltRTauL; sec_side conclude ]
+            | solve [ eapply secEqTauL;            sec_side conclude ]
+            | solve [ eapply secEqTauR;            sec_side conclude ]
+            | solve [ eapply EqVisUnPrivRInd;      sec_side conclude ]
+            | fail 1 "smart_constructor: Tau/Vis unsolved" ]
+  | |- @secure_eqitF _ _ _ _ _ _ _ _ _ _ (VisF _ _) _ =>
+      first [ solve [ eapply EqVisUnPrivLInd;      sec_side conclude ]
+            | solve [ eapply secEqTauR;            sec_side conclude ]
+            | fail 1 "smart_constructor: Vis/? unsolved" ]
+  | |- @secure_eqitF _ _ _ _ _ _ _ _ _ _ _ (VisF _ _) =>
+      first [ solve [ eapply EqVisUnPrivRInd;      sec_side conclude ]
+            | solve [ eapply secEqTauL;            sec_side conclude ]
+            | fail 1 "smart_constructor: ?/Vis unsolved" ]
+  | |- _ => idtac
+  end.
+
+(* #[global] Instance eqit_secure_proper_chain
+  {E R1 R2} (RR : R1 -> R2 -> Prop) Label priv l (b1 b2 : bool)
+  (c : Chain (secure_eqit_mon (E := E) Label priv RR b1 b2 l)) :
+  Proper (eqit_secure Label priv eq false false l ==>
+          eqit_secure Label priv eq false false l ==>
+          flip impl) (elem c).
+Proof. *)
 
-#[global] Instance geutt_cong_euttge:
-  forall {E : Type -> Type} Label priv l b1 b2 {R1 R2 : Type} {RR1 : R1 -> R1 -> Prop}
-    {RR2 : R2 -> R2 -> Prop} {RS : R1 -> R2 -> Prop}
-    (r rg : forall x : itree E R1, (fun _ : itree E R1 => itree E R2) x -> Prop),
-  (forall (x x' : R1) (y : R2), (RR1 x x' : Prop) -> (RS x' y : Prop) -> RS x y) ->
-  (forall (x : R1) (y y' : R2), (RR2 y y' : Prop) -> RS x y' -> RS x y) ->
-  Proper (euttge RR1 ==> euttge RR2 ==> flip impl)
-    (gpaco2 (secure_eqit_ Label priv RS b1 b2 l id) (eqitC RS true true) r rg).
-Proof.
-  repeat intro. gclo. econstructor; eauto.
-Qed.
 
-#[global] Instance geutt_eq_cong_euttge:
-  forall {E : Type -> Type} Label priv l b1 b2 {R1 R2 : Type} r rg RS ,
-    Proper ( @euttge E R1 R1 eq ==> @euttge E R2 R2 eq ==> flip impl)
-           (gpaco2 (secure_eqit_ Label priv RS b1 b2 l id) (eqitC RS true true) r rg ).
+#[global] Instance eqit_secure_proper_chain
+  {E R1 R2} (RR : R1 -> R2 -> Prop) Label priv l (b1 b2 : bool)
+  (c : Chain (secure_eqit_mon (E := E) Label priv RR b1 b2 l)) :
+  Proper (eqit_secure Label priv eq false false l ==>
+          eqit_secure Label priv eq false false l ==>
+          flip impl) (elem c).
 Proof.
-  repeat intro. eapply geutt_cong_euttge; eauto; intros; subst; auto.
+  unfold Proper, respectful, flip, impl.
+  tower induction.
+  intros CIH t1 t2 Ht1t2 t3 t4 Ht3t4 Hbt2t4.
+  icbn; icbn in Hbt2t4.
+  step in Ht1t2; step in Ht3t4.
+  revert t1 t3 Ht1t2 Ht3t4. induction Hbt2t4; intros.
+  - (* secEqRet *)
+    inv Ht1t2; inv Ht3t4; now constructor.
+  - (* secEqTau *)
+    inv Ht1t2; inv Ht3t4; ddestruction;  
+      try contra_size; try contra_leq.
+    all: smart_constructor (by_coinduction CIH).
+  - (* secEqTauL (CHECK : b1) *)
+    inv Ht1t2; ddestruction; try contra_size; try contra_leq.
+    + apply secEqTauL; auto. eapply IHHbt2t4; eauto. now unstep.
+    + apply EqVisUnPrivLInd; auto. intros. eapply IHHbt2t4; eauto. now unstep.
+    + eapply (IHHbt2t4 (Vis _ _)); eauto. now unstep.
+  - (* secEqTauR (CHECK : b2) *)
+    inv Ht3t4; ddestruction;  try contra_size; try contra_leq.
+    + apply secEqTauR; auto. eapply IHHbt2t4; eauto. now unstep.
+    + apply EqVisUnPrivRInd; auto. intros. eapply IHHbt2t4; eauto. now unstep.
+    + eapply (IHHbt2t4 _ (Vis _ _)); eauto. now unstep.
+  - (* EqVisPriv (priv leq) *)
+    inv Ht1t2; inv Ht3t4; ddestruction; 
+      try contra_size; try contra_leq.
+    all: smart_constructor (by_coinduction CIH).
+  - (* EqVisUnPrivTauLCo (left vis nonempty, right tau) *)
+    inv Ht1t2; inv Ht3t4; ddestruction; 
+      try contra_size; try contra_leq.
+    all: smart_constructor (by_coinduction CIH).
+  - (* EqVisUnPrivTauRCo (left tau, right vis nonempty) *)
+    inv Ht1t2; inv Ht3t4; ddestruction; 
+      try contra_size; try contra_leq.
+    all: smart_constructor (by_coinduction CIH).
+  - (* EqVisUnPrivVisCo (left vis nonempty, right vis nonempty) *)
+    inv Ht1t2; inv Ht3t4; ddestruction; 
+      try contra_size; try contra_leq.
+    all: smart_constructor (by_coinduction CIH).
+  - (* EqVisUnPrivLInd (CHECK : b1, left vis nonempty inductive) *)
+    inv Ht1t2; ddestruction;  try contra_size; try contra_leq.
+    + (* Ht1t2 = EqVisUnPrivTauRCo : observe t1 = TauF t5 *)
+      apply secEqTauL; auto.
+      match goal with He : nonempty ?A |- _ => destruct He as [aE] end.
+      eapply (H0 aE); eauto. unstep. eauto.
+    + (* Ht1t2 = EqVisUnPrivVisCo : observe t1 = VisF, nonempty *)
+      apply EqVisUnPrivLInd; auto. intros.
+      match goal with He : nonempty ?A |- _ => destruct He as [aE] end.
+      eapply (H0 aE); eauto. unstep. eauto.
+    + (* Ht1t2 = EqVisUnprivHaltLVisR : observe t1 = VisF, A empty *)
+      match goal with He : nonempty ?A |- _ => destruct He as [aE] end.
+      eapply (H0 aE (Vis _ _)); eauto. unstep. eauto.
+  - (* EqVisUnPrivRInd (CHECK : b2, right vis nonempty inductive) *)
+    inv Ht3t4; ddestruction;  try contra_size; try contra_leq.
+    + (* Ht3t4 = EqVisUnPrivTauLCo : observe t3 = TauF *)
+      apply secEqTauR; auto.
+      match goal with He : nonempty ?A |- _ => destruct He as [aE] end.
+      eapply (H0 aE); eauto. unstep. eauto.
+    + (* Ht3t4 = EqVisUnPrivVisCo : observe t3 = VisF, nonempty *)
+      apply EqVisUnPrivRInd; auto. intros.
+      match goal with He : nonempty ?A |- _ => destruct He as [aE] end.
+      eapply (H0 aE); eauto. unstep. eauto.
+    + (* Ht3t4 = EqVisUnprivHaltRVisL : observe t3 = VisF, B empty *)
+      match goal with He : nonempty ?A |- _ => destruct He as [aE] end.
+      eapply (H0 aE _ (Vis _ _)); eauto. unstep. eauto.
+  - (* EqVisUnprivHaltLTauR (left vis empty, right tau) *)
+    inv Ht1t2; inv Ht3t4; ddestruction; 
+      try contra_size; try contra_leq.
+    all: resolve_sizes.
+    all: smart_constructor (by_coinduction CIH).
+  - (* EqVisUnprivHaltRTauL (left tau, right vis empty) *)
+    inv Ht1t2; inv Ht3t4; ddestruction; 
+      try contra_size; try contra_leq.
+    all: resolve_sizes.
+    all: smart_constructor (by_coinduction CIH).
+  - (* EqVisUnprivHaltLVisR (left vis empty, right vis ~leq) *)
+    inv Ht1t2; inv Ht3t4; ddestruction; 
+      try contra_size; 
+      try contra_leq.
+    all: resolve_sizes.
+    all: smart_constructor (by_coinduction CIH).
+  - (* EqVisUnprivHaltRVisL (left vis ~leq, right vis empty) *)
+    inv Ht1t2; inv Ht3t4; ddestruction; 
+      try contra_size; try contra_leq.
+    all: resolve_sizes.
+    all: smart_constructor (by_coinduction CIH).
+  Unshelve.
+  all: assumption. 
 Qed.
diff --git a/extra/Secure/SecureStateHandler.v b/extra/Secure/SecureStateHandler.v
index 31a65198..ef8dfd83 100644
--- a/extra/Secure/SecureStateHandler.v
+++ b/extra/Secure/SecureStateHandler.v
@@ -1,4 +1,5 @@
-From Coq Require Import Morphisms.
+From Coinduction Require Import all.
+From Stdlib Require Import Morphisms.
 
 From ITree Require Import
      Basics.HeterogeneousRelations
@@ -14,10 +15,9 @@ From ITree.Extra Require Import
      Secure.SecureEqBind
      Secure.SecureEqEuttHalt
      Secure.StrongBisimProper
+     Secure.SecureEqWcompat
 .
 
-From Paco Require Import paco.
-
 Import Monads.
 Import MonadNotation.
 Local Open Scope monad_scope.
@@ -70,24 +70,34 @@ Variant diverges_with' {E : Type -> Type} (P : forall A, E A -> Prop) (A : Type)
 Definition diverges_with_  {E} (P : forall A, E A -> Prop) {A : Type} (F : itree E A -> Prop) :  itree E A -> Prop :=
   fun t => diverges_with' P A F (observe t).
 
-Definition diverges_with {E} (P : forall A, E A -> Prop) {A : Type} : itree E A -> Prop := paco1 (@diverges_with_ E P A) bot1.
-
 Hint Constructors diverges_with' : itree.
 Hint Unfold diverges_with_ : itree.
 
-Lemma mono_diverges_with (E : Type -> Type) P A : monotone1 (@diverges_with_ E P A).
+Lemma diverges_with_mono (E : Type -> Type) P A :
+  Proper (respectful Coinduction.lattice.leq Coinduction.lattice.leq)
+    (@diverges_with_ E P A).
 Proof.
-  red. intros. red. inversion IN; auto with itree.
+  intros F G HFG t Ht. red; red in Ht.
+  inversion Ht; subst.
+  - apply diverges_tau. apply HFG. auto.
+  - apply diverges_vis; auto. intros a; apply HFG; auto.
 Qed.
 
-Hint Resolve mono_diverges_with : paco.
+Definition diverges_with_mon {E} (P : forall A, E A -> Prop) (A : Type) :
+  mon (itree E A -> Prop) := Build_mon (diverges_with_mono E P A).
+
+Definition diverges_with {E} (P : forall A, E A -> Prop) {A : Type} : itree E A -> Prop :=
+  gfp (diverges_with_mon P A).
 
 #[global] Instance proper_diverges_with {E A} {P : forall A, E A -> Prop} : Proper (eq_itree eq ==> iff ) (@diverges_with E P A).
 Proof.
   do 2 red. intros t1 t2 Heq. apply EqAxiom.bisimulation_is_eq in Heq. subst; tauto.
 Qed.
 
-#[global] Instance proper_diverges_with_r  {E A r} {P : forall A, E A -> Prop} : Proper (eq_itree eq ==> iff ) (paco1 (@diverges_with_ E P A) r ).
+
+#[global] Instance proper_diverges_with_elem {E A} {P : forall A, E A -> Prop}
+  (c : Chain (@diverges_with_mon E P A)) :
+  Proper (eq_itree eq ==> iff) (elem c).
 Proof.
   do 2 red. intros t1 t2 Heq. apply EqAxiom.bisimulation_is_eq in Heq. subst; tauto.
 Qed.
@@ -101,17 +111,22 @@ Qed.
 Lemma diverges_with_bind : forall E (P : forall A, E A -> Prop) (A B : Type) (k : A -> itree E B) (t : itree E A) ,
     diverges_with P t -> diverges_with P (ITree.bind t k).
 Proof.
-  intros P A B k. pcofix CIH. intros.
-  pfold. red. unfold observe. cbn.
-  pinversion H0; cbn.
-  - constructor; eauto.
-  - constructor; intros; eauto. right. eapply CIH; eauto. apply H1.
+  intros E P A B k. coinduction c CIH. intros t Hdiv.
+  step in Hdiv. cbn in Hdiv. inversion Hdiv; subst.
+  - (* Tau case *)
+    apply simpobs in H. rewrite H.
+    rewrite bind_tau. apply diverges_tau. apply CIH; auto.
+  - (* Vis case *)
+    apply simpobs in H. rewrite H.
+    rewrite bind_vis. cbn.
+    apply diverges_vis; auto.
+    intros a. apply CIH. apply H0.
 Qed.
 
 Lemma diverges_with_halt : forall E (A B : Type) (e : E A) (k : A -> itree E B) (P : forall A, E A -> Prop),
     P A e -> empty A -> diverges_with P (Vis e k).
 Proof.
-  intros. pfold. constructor; auto. intros; contra_size.
+  intros. step. constructor; auto. intros; contra_size.
 Qed.
 
 Lemma diverges_secure_equiv_halt_r : forall A R1 R2 RR (e : E1 A) (k : A -> itree E1 R1) (t : itree E1 R2),
@@ -120,16 +135,17 @@ Lemma diverges_secure_equiv_halt_r : forall A R1 R2 RR (e : E1 A) (k : A -> itre
     eqit_secure Label priv1 RR true true l (Vis e k) t ->
     diverges_with (fun _ e => ~ leq (priv1 _ e) l) t.
 Proof.
-  intros A R1 R2 RR e k t Hemp Hsec. revert t. pcofix CIH.
-  intros. punfold H0. red in H0.
-  cbn in *. remember (VisF e k) as ov. remember (observe t) as ot.
-  hinduction H0 before r; intros; inv Heqov; subst; ddestruction; subst; try discriminate;  try contradiction;
+  intros A R1 R2 RR e k t Hemp Hsec. revert t. coinduction c CIH.
+  intros. step in H. icbn. 
+  cbn in *. remember (VisF e k) as ov.
+  remember (observe t) as ot.
+  hinduction H before S; intros; inv Heqov; ddestruction; subst; try discriminate;  try contradiction;
     try contra_size; use_simpobs.
-  - rewrite Heqot. pfold. constructor. left. eapply IHsecure_eqitF; eauto.
-  - pclearbot. rewrite Heqot. pfold. constructor; eauto.
-  - rewrite Heqot. pfold. constructor. right. pclearbot. eapply CIH; eauto.
-  - pclearbot. rewrite Heqot. pfold. constructor; auto. right. eapply CIH; eauto. apply H.
-  - rewrite Heqot. pfold. constructor; auto. right. eapply CIH; eauto. contra_size.
+  - etau. eapply CIH. now step.
+  - evis. eapply CIH. now step. 
+  - etau.
+  - evis. eapply CIH; eauto. apply H.
+  - evis. contra_size.
 Qed.
 
 Lemma diverges_secure_equiv_halt_l : forall A R1 R2 RR (e : E1 A) (k : A -> itree E1 R1) (t : itree E1 R2),
@@ -138,64 +154,79 @@ Lemma diverges_secure_equiv_halt_l : forall A R1 R2 RR (e : E1 A) (k : A -> itre
     eqit_secure Label priv1 RR true true l t (Vis e k) ->
     diverges_with (fun _ e => ~ leq (priv1 _ e) l) t.
 Proof.
-  intros A R1 R2 RR e k t Hemp Hsec. revert t. pcofix CIH.
-  intros. punfold H0. red in H0.
+  intros A R1 R2 RR e k t Hemp Hsec. revert t. icoinduction c CIH.
+  intros. step in H.  
   cbn in *. remember (VisF e k) as ov. remember (observe t) as ot.
-  hinduction H0 before r; intros; inv Heqov; subst; ddestruction; subst; try discriminate;  try contradiction;
+  hinduction H before S; intros; inv Heqov; subst; ddestruction; subst; try discriminate;  try contradiction;
     try contra_size; use_simpobs.
-  - rewrite Heqot. pfold. constructor. left. eapply IHsecure_eqitF; eauto.
-  - pclearbot. rewrite Heqot. pfold. constructor; eauto.
-  - rewrite Heqot. pfold. constructor. right. pclearbot. eapply CIH; eauto.
-  - pclearbot. rewrite Heqot. pfold. constructor; auto. right. eapply CIH; eauto. contra_size.
-  - pclearbot. rewrite Heqot. pfold. constructor; auto. right. eapply CIH; eauto. apply H.
+  - etau. eapply CIH. now step.
+  - evis. eapply CIH. now step.
+  - etau. 
+  - evis. contra_size. 
+  - evis. eapply CIH; eauto. apply H.
 Qed.
 
 Lemma diverges_with_spin : forall E A P,
     diverges_with P (@ITree.spin E A).
 Proof.
-  intros. pcofix CIH. pfold. red. cbn. constructor.
-  right; auto.
+  intros. icoinduction c CIH. cbn. constructor.
+  exact CIH. 
 Qed.
 
+
 Lemma eqit_secure_silent_diverge : forall A B RR (t1 : itree E2 A) (t2 : itree E2 B),
     diverges_with (fun _ e => ~ leq (priv2 _ e) l) t1 ->
     diverges_with (fun _ e => ~ leq (priv2 _ e) l) t2 ->
     eqit_secure Label priv2 RR true true l t1 t2.
 Proof.
-  intros A B RR. pcofix CIH. intros.
-  punfold H0. red in H0. punfold H1. red in H1.
-  inversion H0; inversion H1; use_simpobs; try rewrite H; try rewrite H3.
-  - pfold. constructor. right. pclearbot. eapply CIH; eauto.
+  intros A B RR. coinduction c CIH. intros.
+  step in H; step in H0.
+  inversion H; inversion H0; use_simpobs; try rewrite H1; try rewrite H3. 
+  - etau.  
   - destruct (classic_empty B0).
-    + pclearbot. pfold. constructor; auto. pstep_reverse. clear H. clear CIH.
-      generalize dependent t. pcofix CIH. intros.
-      pinversion H2; use_simpobs.
-      * rewrite H. pfold. red. cbn. unpriv_halt.
-      * rewrite H. pfold. red. cbn. unpriv_halt.
-    + pfold. red. cbn. unpriv_co. right. pclearbot. eapply CIH; eauto. apply H4.
-  - pclearbot. destruct (classic_empty B0).
-    + pclearbot. clear H4. clear CIH.
-      generalize dependent t2. pcofix CIH. intros.
-      inversion H4; use_simpobs.
-      * rewrite H1. pfold. red. cbn. pclearbot. unpriv_halt. right. eapply CIH; eauto. punfold H7.
-      * rewrite H1. pfold. red. cbn. unpriv_halt. right. pclearbot. eapply CIH; eauto. pstep_reverse.
-    + rewrite H4. pfold. red. cbn. unpriv_co. right. pclearbot. eapply CIH; eauto. apply H2.
-  - pclearbot. rewrite H4.
+    + constructor; auto. step. clear H1. clear CIH.
+    (* TOUR annoying: need coinduction bug fix *)
+    change (gfp (diverges_with_mon (fun (A : Type) (e : E2 A) => ~ leq (priv2 A e) l) A) t)
+    with (diverges_with (fun (A : Type) (e : E2 A) => ~ leq (priv2 A e) l) t) in H2. 
+    generalize dependent t. coinduction c' CIH'. intros.
+      sinv H2; use_simpobs.
+      * rewrite H1. icbn; cbn. 
+      unpriv_halt.  
+      * rewrite H1. icbn; cbn. unpriv_halt. eapply CIH'; eauto. apply H7. 
+    + cbn. unpriv_co. eapply CIH; eauto. apply H4.
+  -  destruct (classic_empty B0).
+    +  clear H4. clear CIH. step. 
+       change (diverges_with' (fun (A : Type) (e : E2 A) => ~ leq (priv2 A e) l) B
+(gfp (diverges_with_mon (fun (A : Type) (e : E2 A) => ~ leq (priv2 A e)
+l) B)) (observe t2)) with (diverges_with' (fun (A : Type) (e : E2 A) => ~ leq (priv2 A e) l) B (diverges_with (fun (A : Type) (e : E2 A) => ~ leq (priv2 A e) l)) (observe t2)) in H0.
+      generalize dependent t2. coinduction c' CIH. intros.
+      inversion H0; use_simpobs.
+      * rewrite H4. icbn; cbn. unpriv_halt. eapply CIH; eauto. now step in H7. 
+      * rewrite H4. icbn; cbn. unpriv_halt. eapply CIH; eauto. unfold diverges_with. unstep. apply H7.  
+    + rewrite H4. icbn; cbn. unpriv_co. eapply CIH; eauto. apply H2.
+  -  rewrite H4.
     destruct (classic_empty B0); destruct (classic_empty B1).
-    + pfold. red. cbn. unpriv_halt. contra_size.
-    + assert (diverges_with (fun _ e => ~ leq (priv2 _ e) l) (Vis e0 k0)).
-      { pfold. constructor; auto. }
-      rewrite <- H4. rewrite <- H4 in H9. clear H4. clear H1 CIH. generalize dependent t2.
-      pcofix CIH. intros. pinversion H9; use_simpobs.
-      * rewrite H1. pfold. red. cbn. unpriv_halt.
-      * rewrite H1. pfold. red. cbn. unpriv_halt. right. eapply CIH; eauto. apply H4.
-    + assert (diverges_with (fun _ e => ~ leq (priv2 _ e) l) (Vis e k)).
-      { pfold. constructor; auto. }
-      rewrite <- H. rewrite <- H in H9. clear H. clear H0 CIH. generalize dependent t1.
-      pcofix CIH. intros. pinversion H9; use_simpobs.
-      * rewrite H. pfold. red. cbn. unpriv_halt.
-      * rewrite H. pfold. red. cbn. unpriv_halt. right. eapply CIH; eauto. apply H0.
-    + pfold. red. cbn. unpriv_co. right. eapply CIH; eauto. apply H2. apply H5.
+    + icbn; cbn. unpriv_halt. contra_size.
+    + assert (diverges_with (fun _ e => ~ leq (priv2 _ e) l) (Vis e0 k0)) by 
+       (step; constructor; auto). 
+      rewrite <- H4. rewrite <- H4 in H9. clear H4. clear H1 CIH. step.
+      change (diverges_with' (fun (A : Type) (e : E2 A) => ~ leq (priv2 A e) l) B
+      (gfp (diverges_with_mon (fun (A : Type) (e : E2 A) => ~ leq (priv2 A e) l) B)) (observe t2))
+      with 
+      (diverges_with' (fun (A : Type) (e : E2 A) => ~ leq (priv2 A e) l) B
+      (diverges_with (fun (A : Type) (e : E2 A) => ~ leq (priv2 A e) l)) (observe t2)) in H0. 
+      generalize dependent t2.
+      coinduction c0 CIH. intros. sinv H9; use_simpobs.
+      * rewrite H1. icbn; cbn. unpriv_halt. eapply CIH; eauto. now step in H4.  
+      * rewrite H1. icbn; cbn. unpriv_halt. eapply CIH; eauto. 
+      specialize (H4 b). now step in H4. apply H4. 
+    + assert (diverges_with (fun _ e => ~ leq (priv2 _ e) l) (Vis e k)) by 
+       (step; constructor; auto). 
+      rewrite <- H1. rewrite <- H1 in H9. clear H1. clear H CIH. step. generalize dependent t1.
+      coinduction c0 CIH. intros. sinv H9; use_simpobs.
+      * rewrite H. icbn; cbn. unpriv_halt.
+      * rewrite H. icbn; cbn. unpriv_halt. eapply CIH; eauto. apply H1.
+    + icbn; cbn. unpriv_co. eapply CIH; eauto. apply H2. apply H5.
 Qed.
 
 Lemma silent_diverges_eqit_secure_spin : forall A B (RR : A -> B -> Prop) (t : itree E2 A),
@@ -203,23 +234,20 @@ Lemma silent_diverges_eqit_secure_spin : forall A B (RR : A -> B -> Prop) (t : i
 Proof.
   intros. split.
   { intros. eapply eqit_secure_silent_diverge; eauto. apply diverges_with_spin. }
-  revert t. pcofix CIH.
-  intros t Ht. punfold Ht. red in Ht. remember (observe t) as ot.
+  revert t. coinduction c CIH.
+  intros t Ht. step in Ht. remember (observe t) as ot.
   remember (observe ITree.spin) as otspin.
-  hinduction Ht before r; intros; subst; try discriminate; use_simpobs.
-  - pclearbot. rewrite Heqot. pfold. constructor. right. eapply CIH; eauto. rewrite Heqotspin.
-    pfold; constructor; auto. pstep_reverse.
-  - rewrite Heqot. pfold; constructor. left. eapply IHHt; eauto.
-  - eapply IHHt; eauto. assert (ITree.spin ≅ t2).
-    { clear IHHt Ht. generalize dependent t2. pcofix CIH'.
-      intros. punfold Heqotspin. red in Heqotspin.  cbn in *. inversion Heqotspin; try inv CHECK0.
-      subst. pclearbot. eapply paco2_mon; eauto; intros; try contradiction. }
+  hinduction Ht before S; intros; subst; try discriminate; use_simpobs.
+  -  rewrite Heqot. constructor. eapply CIH; eauto. rewrite Heqotspin.
+    step; constructor; auto. now unstep.
+  - rewrite Heqot. constructor. step. eapply IHHt; eauto.
+  - eapply IHHt; eauto. assert (ITree.spin ≅ t2) by sinv Heqotspin. 
     apply EqAxiom.bisimulation_is_eq in H. subst; auto.
-  - rewrite Heqot. pfold. constructor; auto. right. eapply CIH; eauto. pclearbot. rewrite Heqotspin.
-    pfold; constructor; auto. pstep_reverse.
-  - rewrite Heqot. pfold. constructor; auto. left. eapply H0; eauto.
-  - rewrite Heqot. pclearbot. pfold; constructor; auto. right. eapply CIH; eauto.
-    rewrite Heqotspin. pfold; constructor; auto. pstep_reverse.  eapply unpriv_e_eqit_secure; eauto.
+  - rewrite Heqot. constructor; auto; intros. eapply CIH; eauto. rewrite Heqotspin.
+    step; etau. now unstep. 
+  - rewrite Heqot. evis. step. eapply H0; eauto.
+  - rewrite Heqot. evis. eapply CIH; eauto.
+    rewrite Heqotspin. step; constructor; auto. unstep. eapply unpriv_e_eqit_secure; eauto.
 Qed.
 
 
@@ -229,14 +257,14 @@ Proof.
   split; intros.
   - red. intros. specialize (H0 s1).
     cbn. induction H0.
-    + pfold; constructor. split; try constructor. cbn. etransitivity; eauto. symmetry. auto.
-    + pfold; constructor; auto. pstep_reverse. eapply IHterminates; eauto.
-    + destruct H3. pfold. red. cbn. timeout 10 setoid_rewrite itree_eta' at 2.  unpriv_ind.
-      pstep_reverse. eapply H2; eauto.
+    + step; constructor. split; try constructor. cbn. etransitivity; [symmetry|]; eauto. 
+    + step; constructor; auto. unstep. eapply IHterminates; eauto.
+    + destruct H3. step. cbn. timeout 10 setoid_rewrite itree_eta' at 2.  unpriv_ind.
+      unstep. eapply H2; eauto.
   - cbn in *. red in H0. assert (RS s s). reflexivity.
     inv H.
     specialize (H0 a s s H1). remember (m s) as t. clear Heqt.
-    punfold H0. red in H0. cbn in H0. remember (RetF (s,a) ) as oret. remember (observe t) as ot.
+    step in H0. cbn in H0. remember (RetF (s,a) ) as oret. remember (observe t) as ot.
     hinduction H0 before E1; intros; try discriminate; use_simpobs.
     + rewrite Heqot. injection Heqoret; intros; subst. destruct r1, H. cbn in *.
       constructor. symmetry. auto.
@@ -266,134 +294,112 @@ Lemma diverge_with_respectful_handler : forall (R : Type) (t : itree E1 R),
     diverges_with (fun _ e => ~ leq (priv1 _ e) l ) t ->
     forall s, diverges_with (fun _ e => ~ leq (priv2 _ e) l) (interp_state handler t s).
 Proof.
-  intro R. pcofix CIH. intros t Hdiv s. pinversion Hdiv; use_simpobs.
-  - rewrite H. rewrite interp_state_tau. pfold. constructor. right. eapply CIH; eauto.
+  intro R. coinduction c CIH. intros t Hdiv s. sinv Hdiv; use_simpobs.
+  - rewrite H. rewrite interp_state_tau. constructor. eapply CIH; eauto.
   - rewrite H. rewrite interp_state_vis.
     destruct (classic_empty B).
     + specialize (Hhandler _ e). destruct Hhandler; try contradiction; try contra_size.
-      specialize (DIVCHECK s). eapply paco1_mon with (r:= bot1). eapply diverges_with_bind; eauto.
-      intros; contradiction.
+      specialize (DIVCHECK s). step. eapply diverges_with_bind; eauto.
     + specialize (Hhandler _ e). destruct Hhandler; try contradiction; try contra_size.
       specialize (FINCHECK s). induction FINCHECK.
-      * rewrite bind_ret_l. cbn. pfold. constructor. right. eapply CIH; eauto. apply H0.
-      * rewrite bind_tau. pfold. constructor. left. eapply IHFINCHECK; eauto.
-      * destruct H5. rewrite bind_vis. pfold. constructor; auto. left. eapply H4; eauto.
+      * rewrite bind_ret_l. cbn. etau. eapply CIH; eauto. apply H0.
+      * rewrite bind_tau. etau. step. eapply IHFINCHECK; eauto.
+      * destruct H5. rewrite bind_vis. evis. step. eapply H4; eauto.
 Qed.
 
-
-
 Lemma interp_eqit_secure_state : forall (R1 R2 : Type) (RR : R1 -> R2 -> Prop) (t1 : itree E1 R1) (t2 : itree E1 R2),
     eqit_secure Label priv1 RR true true l t1 t2 ->
     state_eqit_secure true true RR (interp_state handler t1) (interp_state handler t2).
 Proof.
-  intros R1 R2 RR. pcofix CIH. intros t1 t2 Ht s1 s2 Hs. punfold Ht.
-  red in Ht. remember (observe t1) as ot1. remember (observe t2) as ot2.
-  hinduction Ht before r; intros; use_simpobs.
-  - rewrite Heqot1. rewrite Heqot2. repeat rewrite interp_state_ret. pfold. constructor. auto.
-  - rewrite Heqot1. rewrite Heqot2. repeat rewrite interp_state_tau. pfold. constructor.
-    pclearbot. right. apply CIH; auto.
-  - rewrite Heqot1. rewrite interp_state_tau. pfold. constructor; auto. pstep_reverse.
-  - rewrite Heqot2. rewrite interp_state_tau. pfold. constructor; auto. pstep_reverse.
-  - rewrite Heqot1. rewrite Heqot2. repeat rewrite interp_state_vis.
-    specialize (Hhandler A e). pclearbot. repeat rewrite bind_tau.
-    (* could use the bind closure here, but maybe we can do manually for now*)
+  intros R1 R2 RR. coinduction c CIH. intros t1 t2 Ht s1 s2 Hs. step in Ht.
+  genobs t1 ot1. genobs t2 ot2.
+  hinduction Ht before l; intros; use_simpobs.
+  - rewrite Heqot1. rewrite Heqot2. rewrite 2 interp_state_ret. eret.
+  - rewrite Heqot1. rewrite Heqot2. rewrite 2 interp_state_tau. etau.
+  - rewrite Heqot1. rewrite interp_state_tau. constructor; auto. eapply IHHt; eauto.
+  - rewrite Heqot2. rewrite interp_state_tau. constructor; auto. eapply IHHt; eauto.
+  - rewrite Heqot1. rewrite Heqot2. rewrite 2 interp_state_vis.
+    specialize (Hhandler A e). repeat rewrite bind_tau.
     repeat setoid_rewrite <- interp_state_tau. inv Hhandler; try contradiction.
     specialize (RESCHECK s1 s2 Hs).
-    eapply secure_eqit_bind'; eauto. intros [] [] []. simpl in *. subst.
-    repeat rewrite interp_state_tau.
-    pfold. constructor. right. eapply CIH; eauto. apply H.
-  - pclearbot. rewrite Heqot1. rewrite Heqot2.
-    rewrite interp_state_tau. rewrite interp_state_vis.
+    eapply secure_eqit_bind_chain; eauto. intros [] [] []. simpl in *. subst.
+    rewrite 2 interp_state_tau. constructor. eapply CIH; eauto. apply H.
+  - rewrite Heqot1. rewrite Heqot2. rewrite interp_state_tau. rewrite interp_state_vis.
     specialize (Hhandler A e). inv Hhandler; try contradiction; try contra_size.
     specialize (FINCHECK s1). induction FINCHECK.
-    + rewrite bind_ret_l. pstep. constructor. right.
-      apply CIH. apply H. etransitivity; [symmetry |]; eauto.
-    + rewrite bind_tau. pstep. constructor 3; auto. pstep_reverse.
-    + rewrite bind_vis. pstep. destruct H2. constructor 9; auto. intros. pstep_reverse.
-  - pclearbot. rewrite Heqot1. rewrite Heqot2.
-    rewrite interp_state_tau. rewrite interp_state_vis.
+    + rewrite bind_ret_l. constructor. apply CIH. apply H. etransitivity; [symmetry |]; eauto.
+    + rewrite bind_tau. constructor 3; auto. eapply IHFINCHECK; eauto.
+    + rewrite bind_vis. destruct H2. constructor 9; auto. intros. eapply H1; eauto.
+  - rewrite Heqot1. rewrite Heqot2. rewrite interp_state_tau. rewrite interp_state_vis.
     specialize (Hhandler A e). inv Hhandler; try contradiction; try contra_size.
     specialize (FINCHECK s2). induction FINCHECK.
-    + rewrite bind_ret_l. pstep. constructor. right.
-      apply CIH. apply H. etransitivity; eauto.
-    + rewrite bind_tau. pstep. constructor 4; auto. pstep_reverse.
-    + rewrite bind_vis. pstep. destruct H2. constructor 10; auto. intros. pstep_reverse.
-  - pclearbot. rewrite Heqot1. rewrite Heqot2. repeat rewrite interp_state_vis.
+    + rewrite bind_ret_l. constructor. apply CIH. apply H. etransitivity; eauto.
+    + rewrite bind_tau. constructor 4; auto. eapply IHFINCHECK; eauto.
+    + rewrite bind_vis. destruct H2. constructor 10; auto. intros. eapply H1; eauto.
+  - rewrite Heqot1. rewrite Heqot2. rewrite 2 interp_state_vis.
     specialize (Hhandler _ e1) as He1. specialize (Hhandler _ e2) as He2.
     inv He1; inv He2; try contradiction; try contra_size.
-    eapply secure_eqit_bind' with (RR := prod_rel RS (fun _ _ => True)).
-    + intros [] [] ?. pstep. constructor. right.
-      apply CIH. apply H. simpl. apply H0.
-    + specialize (FINCHECK s1). specialize (FINCHECK0 s2).
-      induction FINCHECK.
-      * induction FINCHECK0.
-        -- simpl. pstep. constructor. split; auto. simpl.
-           transitivity s2; eauto. etransitivity; [symmetry |]; eauto.
-        -- pstep. constructor; auto. pstep_reverse. eapply IHFINCHECK0; eauto.
-        -- pstep. destruct H3. constructor; auto. intros. pstep_reverse. eapply H2; eauto.
-      * pstep. constructor; auto. pstep_reverse. eapply IHFINCHECK; eauto.
-      * pstep. destruct H2. constructor; auto. intros. pstep_reverse. eapply H1; eauto.
-  - rewrite Heqot1. rewrite interp_state_vis. specialize (Hhandler _ e).
-    inv Hhandler; try contradiction; try contra_size.
+    eapply secure_eqit_bind_chain with (RR := prod_rel RS (fun _ _ => True)).
+    2: { intros [s1' a1] [s2' a2] [Hs' Hgar]. simpl in *. constructor. apply CIH. apply H. apply Hs'. }
+    specialize (FINCHECK s1). specialize (FINCHECK0 s2). induction FINCHECK.
+    + induction FINCHECK0.
+      * simpl. step. constructor. split; auto. simpl. transitivity s2; eauto. etransitivity; [symmetry |]; eauto.
+      * step. constructor; auto. unstep. eapply IHFINCHECK0; eauto.
+      * step. destruct H3. constructor; auto. intros. unstep. eapply H2; eauto.
+    + step. constructor; auto. unstep. eapply IHFINCHECK; eauto.
+    + step. destruct H2. constructor; auto. intros. unstep. eapply H1; eauto.
+  - rewrite Heqot1. rewrite interp_state_vis. pose proof (Hhandler _ e) as He.
+    inv He; try contradiction; try contra_size.
     specialize (FINCHECK s1). induction FINCHECK.
-    + rewrite bind_ret_l. pstep. constructor; auto. pstep_reverse.
-      eapply H0; eauto. simpl. etransitivity; [symmetry |]; eauto.
-    + rewrite bind_tau. pstep. constructor 3; auto. pstep_reverse.
-    + rewrite bind_vis. pstep. destruct H3. constructor 9; auto. intros. pstep_reverse.
-  - rewrite Heqot2. rewrite interp_state_vis. specialize (Hhandler _ e).
-    inv Hhandler; try contradiction; try contra_size.
+    + rewrite bind_ret_l. constructor; auto. eapply H0; eauto. simpl. etransitivity; [symmetry |]; eauto.
+    + rewrite bind_tau. constructor 3; auto. eapply IHFINCHECK; eauto.
+    + rewrite bind_vis. destruct H3. constructor 9; auto. intros. eapply H2; eauto.
+  - rewrite Heqot2. rewrite interp_state_vis. pose proof (Hhandler _ e) as He.
+    inv He; try contradiction; try contra_size.
     specialize (FINCHECK s2). induction FINCHECK.
-    + rewrite bind_ret_l. pstep. constructor 4; auto. pstep_reverse.
-      eapply H0; eauto. simpl. etransitivity; eauto.
-    + rewrite bind_tau. pstep. constructor 4; auto. pstep_reverse.
-    + rewrite bind_vis. pstep. destruct H3. constructor 10; auto. intros. pstep_reverse.
-  - pclearbot.
-    rewrite Heqot1. rewrite interp_state_vis.
-    rewrite Heqot2. rewrite interp_state_tau.
-    pose proof Hhandler as Hhandler'.
-    specialize (Hhandler' _ e). inv Hhandler'; try contradiction; try contra_size.
-    eapply paco2_mon with (r:= bot2); intros; try contradiction. eapply eqit_secure_silent_diverge.
+    + rewrite bind_ret_l. constructor 4; auto. eapply H0; eauto. simpl. etransitivity; eauto.
+    + rewrite bind_tau. constructor 4; auto. eapply IHFINCHECK; eauto.
+    + rewrite bind_vis. destruct H3. constructor 10; auto. intros. eapply H2; eauto.
+  - rewrite Heqot1. rewrite interp_state_vis. rewrite Heqot2. rewrite interp_state_tau.
+    pose proof Hhandler as Hhandler'. specialize (Hhandler' _ e). inv Hhandler'; try contradiction; try contra_size.
+    step. eapply eqit_secure_silent_diverge.
     + eapply diverges_with_bind; eauto.
-    + pfold. constructor. left. eapply diverge_with_respectful_handler; eauto.
-      eapply diverges_secure_equiv_halt_r; eauto.
-  - pclearbot.
-    rewrite Heqot1. rewrite interp_state_tau.
-    rewrite Heqot2. rewrite interp_state_vis.
-    pose proof Hhandler as Hhandler'.
-    specialize (Hhandler' _ e). inv Hhandler'; try contradiction; try contra_size.
-    eapply paco2_mon with (r:= bot2); intros; try contradiction. eapply eqit_secure_silent_diverge.
-    + pfold. constructor. left. eapply diverge_with_respectful_handler; eauto.
-      eapply diverges_secure_equiv_halt_l; eauto.
+    + step. constructor. eapply diverge_with_respectful_handler; eauto. eapply diverges_secure_equiv_halt_r; eauto.
+  - rewrite Heqot1. rewrite interp_state_tau. rewrite Heqot2. rewrite interp_state_vis.
+    pose proof Hhandler as Hhandler'. specialize (Hhandler' _ e). inv Hhandler'; try contradiction; try contra_size.
+    step. eapply eqit_secure_silent_diverge.
+    + step. constructor. eapply diverge_with_respectful_handler; eauto. eapply diverges_secure_equiv_halt_l; eauto.
     + eapply diverges_with_bind; eauto.
-  - pclearbot. rewrite Heqot1. rewrite Heqot2. repeat rewrite interp_state_vis.
-    pose proof Hhandler as Hhandler'.
-    pose proof Hhandler as Hhandler''.
+  - rewrite Heqot1. rewrite Heqot2. rewrite 2 interp_state_vis.
+    pose proof Hhandler as Hhandler'. pose proof Hhandler as Hhandler''.
     specialize (Hhandler'' _ e2). inv Hhandler''; try contradiction; try contra_size.
-    specialize (Hhandler' _ e1). inv Hhandler'; try contradiction; try contra_size.
-    eapply paco2_mon with (r:= bot2); intros; try contradiction. eapply eqit_secure_silent_diverge.
-    + eapply diverges_with_bind; eauto.
-    + specialize (FINCHECK s2). induction FINCHECK.
-      * rewrite bind_ret_l. pfold; constructor. left. cbn.
-        eapply diverge_with_respectful_handler; eauto. eapply diverges_secure_equiv_halt_r; eauto.
-        apply H.
-      * rewrite bind_tau. pfold; constructor. left. eapply IHFINCHECK; eauto.
-      * rewrite bind_vis. pfold. constructor. left. eapply H1; eauto. destruct H2; auto.
-    + eapply paco2_mon with (r:= bot2); intros; try contradiction. eapply eqit_secure_silent_diverge.
-      * apply diverges_with_bind. specialize (Hhandler _ e1). inv Hhandler; try contradiction; try contra_size; auto.
-      * apply diverges_with_bind; auto.
-  - pclearbot. rewrite Heqot1. rewrite Heqot2. repeat rewrite interp_state_vis.
-    pose proof Hhandler as Hhandler'.
-    pose proof Hhandler as Hhandler''.
-    eapply paco2_mon with (r:= bot2); intros; try contradiction. eapply eqit_secure_silent_diverge.
-    + specialize (Hhandler'' _ e1). inv Hhandler''; try contradiction; try contra_size.
-      * specialize (FINCHECK s1). induction FINCHECK.
-        ++ rewrite bind_ret_l. pfold; constructor. cbn. left.
-           eapply diverge_with_respectful_handler. eapply diverges_secure_equiv_halt_l; eauto. apply H.
-        ++ rewrite bind_tau. pfold. constructor. left. eapply IHFINCHECK; eauto.
-        ++ destruct H2. rewrite bind_vis. pfold. constructor; auto. left. eapply H1; eauto.
-      * apply diverges_with_bind; auto.
-    + specialize (Hhandler'' _ e2). inv Hhandler''; try contradiction; try contra_size.
-      apply diverges_with_bind; auto.
-Qed.
+    { specialize (Hhandler' _ e1). inv Hhandler'; try contradiction; try contra_size.
+     step. eapply eqit_secure_silent_diverge.
+      - eapply diverges_with_bind; eauto.
+      - specialize (FINCHECK s2). induction FINCHECK.
+        + rewrite bind_ret_l. step. constructor. cbn. eapply diverge_with_respectful_handler; eauto. eapply diverges_secure_equiv_halt_r; eauto. apply H.
+        + rewrite bind_tau. step. constructor. eapply IHFINCHECK; eauto.
+        + rewrite bind_vis. step. constructor; auto. intros. eapply H1; eauto. destruct H2; auto. }
+        { specialize (Hhandler' _ e1). inv Hhandler'; try contradiction; try contra_size.
+        step. eapply eqit_secure_silent_diverge.
+        + eapply diverges_with_bind; eauto.
+        + eapply diverges_with_bind; eauto. }
+  - rewrite Heqot1, Heqot2. rewrite 2 interp_state_vis. 
+    pose proof Hhandler as Hhandler'. pose proof Hhandler as Hhandler''.
+    specialize (Hhandler'' _ e2). specialize (Hhandler' _ e1).   
+    inv Hhandler'; try contradiction; try contra_size.
+    { inv Hhandler''; try contradiction; try contra_size. 
+     step. eapply eqit_secure_silent_diverge.
+      - specialize (FINCHECK s1). induction FINCHECK.
+        + rewrite bind_ret_l. step. constructor. cbn. eapply diverge_with_respectful_handler; eauto. eapply diverges_secure_equiv_halt_l; eauto.  apply H.
+        + rewrite bind_tau. step. constructor. eapply IHFINCHECK; eauto.
+        + rewrite bind_vis. step. constructor; auto. intros. eapply H1; eauto. destruct H2; auto.
+      - eapply diverges_with_bind; eauto.   
+        }
+        { inv Hhandler''; try contradiction; try contra_size.
+        step. eapply eqit_secure_silent_diverge.
+        + eapply diverges_with_bind; eauto.
+        + eapply diverges_with_bind; eauto. }
+Qed. 
 
 End GeneralStateHandler.
diff --git a/extra/Secure/SecureStateHandlerPi.v b/extra/Secure/SecureStateHandlerPi.v
index 5a87a3c5..57be1365 100644
--- a/extra/Secure/SecureStateHandlerPi.v
+++ b/extra/Secure/SecureStateHandlerPi.v
@@ -1,4 +1,5 @@
-From Coq Require Import Morphisms.
+From Coinduction Require Import all. 
+From Stdlib Require Import Morphisms.
 From ITree Require Import
      Axioms
      ITree
@@ -22,8 +23,6 @@ Import Monads.
 Import MonadNotation.
 Local Open Scope monad_scope.
 
-From Paco Require Import paco.
-
 Section GeneralStateHandler.
 
 Context (S : Type).
@@ -54,24 +53,22 @@ Definition secure_in_empty_context  {R} (m : stateT S (itree E2) R) :=
 Lemma diverges_with_spin : forall E A P,
     diverges_with P (@ITree.spin E A).
 Proof.
-  intros. pcofix CIH. pfold. red. cbn. constructor.
-  right; auto.
+  intros. icoinduction c CIH. cbn. etau. 
 Qed.
 
 Lemma pi_eqit_secure_silent_divergel : forall A B RR (t1 : itree E2 A) (t2 : itree E2 B),
     diverges_with (fun _ e => ~ leq (priv2 _ e) l) t1 ->
     pi_eqit_secure Label priv2 RR true true l t1 t2.
 Proof.
-  intros A B RR. pcofix CIH. intros.
-  punfold H0. all : try apply mono_diverges_with. red in H0.
-  inversion H0; use_simpobs; try rewrite H; try rewrite H3.
-  - pfold. constructor; auto. right. pclearbot. eapply CIH; eauto.
+  intros A B RR. coinduction c CIH. intros.
+  step in H. all : try apply mono_diverges_with. 
+  inversion H; use_simpobs; try rewrite H0; try rewrite H1.
+  - etau. 
   - destruct (classic_empty B0).
-    + eapply paco2_mon with (r := bot2); intros; try contradiction.
+    + step. 
       apply pi_eqit_secure_sym.
       apply pi_eqit_secure_private_halt; auto.
-    + pfold. red. cbn. constructor; auto. right. pclearbot. eapply CIH; eauto.
-      apply H1.
+    + icbn. evis. eapply CIH; eauto. apply H1.
  Qed.
 
 Lemma pi_eqit_secure_silent_diverger : forall A B RR (t1 : itree E2 A) (t2 : itree E2 B),
@@ -87,9 +84,8 @@ Lemma silent_terminates_eqit_secure_ret : forall R (m : stateT S (itree E2) R),
 Proof.
   red. intros. specialize (H0 s1).
   cbn. induction H0.
-  - pfold; constructor. split; try constructor. cbn. etransitivity; eauto. symmetry. auto.
-  - pfold; constructor; auto.
-    left. eapply IHterminates; auto.
+  - step; constructor. split; try constructor. cbn. etransitivity; [symmetry|]; eauto.
+  - step; constructor; auto. apply IHterminates; auto. 
   - apply pi_eqit_secure_priv_visl; auto. destruct H3. auto.
 Qed.
 
@@ -103,140 +99,192 @@ Variant handler_respects_priv (A : Type) (e : E1 A) : Prop :=
 
 Context (Hhandler : forall A (e : E1 A), handler_respects_priv A e).
 
-Hint Resolve mono_diverges_with : paco.
-(*
-Lemma diverge_with_respectful_handler : forall (R : Type) (t : itree E1 R),
-    diverges_with (fun _ e => ~ leq (priv1 _ e) l ) t ->
-    forall s, diverges_with (fun _ e => ~ leq (priv2 _ e) l) (interp_state handler t s).
-Proof.
-  intro R. pcofix CIH. intros t Hdiv s. pinversion Hdiv; use_simpobs.
-  - rewrite H. rewrite interp_state_tau. pfold. constructor. right. eapply CIH; eauto.
-  - rewrite H. rewrite interp_state_vis.
-    destruct (classic_empty B).
-    + specialize (Hhandler _ e). destruct Hhandler; try contradiction; try contra_size.
-      specialize (DIVCHECK s). eapply paco1_mon with (r:= bot1). eapply diverges_with_bind; eauto.
-      intros; contradiction.
-    + specialize (Hhandler _ e). destruct Hhandler; try contradiction; try contra_size.
-      specialize (FINCHECK s). induction FINCHECK.
-      * rewrite bind_ret_l. cbn. pfold. constructor. right. eapply CIH; eauto. apply H0.
-      * rewrite bind_tau. pfold. constructor. left. eapply IHFINCHECK; eauto.
-      * destruct H5. rewrite bind_vis. pfold. constructor; auto. left. eapply H4; eauto.
-Qed.
-*)
+
 Lemma diverges_with_bind : forall E R S P (t : itree E R) (k : R -> itree E S),
     diverges_with P t -> diverges_with P (ITree.bind t k).
 Proof.
-  intros E R1 R2 P. pcofix CIH.
-  intros t k Ht. punfold Ht. pfold. red.
-  unfold observe. cbn. red in Ht. inv Ht.
-  - cbn. constructor. right. pclearbot. eapply CIH; eauto.
-  - pclearbot. cbn. constructor; auto. right. eapply CIH; eauto. apply H0.
+  intros E R1 R2 P. icoinduction c CIH.
+  intros t k Ht. step in Ht. 
+  unfold observe. inv Ht; cbn; simpobs. 
+  - etau.
+  - evis. eapply CIH; eauto. apply H0.
 Qed.
 
 Lemma interp_pi_eqit_secure_state : forall (R1 R2 : Type) (RR : R1 -> R2 -> Prop) (t1 : itree E1 R1) (t2 : itree E1 R2),
     pi_eqit_secure Label priv1 RR true true l t1 t2 ->
     state_pi_eqit_secure true true RR (interp_state handler t1) (interp_state handler t2).
 Proof.
-  intros R1 R2 RR. ginit. gcofix CIH. intros t1 t2 Ht s1 s2 Hs. punfold Ht.
-  red in Ht.
+
+  intros R1 R2 RR. coinduction c CIH. intros t1 t2 Ht s1 s2 Hs. step in Ht.
   inv Ht; intros; use_simpobs.
-  - rewrite H, H0. repeat rewrite interp_state_ret. gstep. constructor.
-    split; auto.
-  - rewrite H, H0. repeat rewrite interp_state_tau. gstep. constructor.
-    gfinal. left. pclearbot. apply CIH; auto.
-  - pclearbot. rewrite H. rewrite interp_state_tau. gstep. constructor; auto.
-    gfinal. left. eapply CIH; eauto. apply simpobs in H0. rewrite <- itree_eta in H0.
+  - rewrite H, H0. repeat rewrite interp_state_ret. eret. 
+  - rewrite H, H0. repeat rewrite interp_state_tau. etau. 
+  - rewrite H. rewrite interp_state_tau. etau. 
+    eapply CIH; eauto. apply simpobs in H0. rewrite <- itree_eta in H0.
     rewrite H0. auto.
-  - pclearbot. rewrite H0. rewrite interp_state_tau. gstep. constructor; auto.
-    gfinal. left. eapply CIH; eauto. apply simpobs in H. rewrite <- itree_eta in H.
+  - rewrite H0. rewrite interp_state_tau. etau. 
+    eapply CIH; eauto. apply simpobs in H. rewrite <- itree_eta in H.
     rewrite H. auto.
-  - pclearbot. rewrite H, H0.
+  - rewrite H, H0.
     repeat rewrite interp_state_vis.
     specialize (Hhandler A e). inv Hhandler; try contradiction.
-    eapply pi_secure_eqit_bind'; eauto.
+    eapply pi_eqit_secure_bind; eauto.
     intros. destruct H2; destruct r1; destruct r2; cbn in *; subst.
-    pfold. constructor. right. eapply CIH; eauto. apply H1.
-  - rewrite H, H0. pclearbot. rewrite interp_state_tau.
-    gstep. constructor; auto. rewrite interp_state_vis.
+    constructor. eapply CIH; eauto. apply H1.
+  - rewrite H, H0.  rewrite interp_state_tau.
+    constructor; auto. rewrite interp_state_vis.
     specialize (Hhandler A e). inv Hhandler; try contradiction.
     red in RESCHECK. apply RESCHECK in Hs as He.
     remember (handler A e s1) as t3. clear Heqt3.
-    cbn in He. generalize dependent t3. gcofix CIH'.
-    intros t3 Ht3. pinversion Ht3; use_simpobs; subst.
-    + destruct H4. cbn in *. destruct r1. cbn in *.
-      rewrite H2. rewrite bind_ret_l. gstep. constructor; auto.
-      gfinal. left. eapply CIH'0. eapply CIH; eauto. cbn. apply H1.
-    + rewrite H2. rewrite bind_tau. gstep; constructor; auto.
-      gfinal. left. eapply CIH'; eauto. symmetry in H3. use_simpobs.
+    generalize dependent t3. accumulate CIH'. 
+    intros t3 Ht3. cbn in Ht3. sinv Ht3; use_simpobs; subst.
+    + destruct H4. destruct r1. cbn in *|-.
+      rewrite H2. rewrite bind_ret_l. constructor; auto.
+      eapply CIH; eauto. cbn. apply H1.
+    + rewrite H2. rewrite bind_tau. constructor; auto.
+      eapply CIH'; eauto. symmetry in H3. use_simpobs.
       rewrite <- H3. auto.
-    + rewrite H2. rewrite bind_vis. gstep. constructor; auto.
-      intros. gfinal. left. eapply CIH'; eauto. symmetry in H3.
+    + rewrite H2. rewrite bind_vis. constructor; auto.
+      intros. eapply CIH'; eauto. symmetry in H3.
       use_simpobs. rewrite <- H3. apply H4.
- - rewrite H, H0. pclearbot. rewrite interp_state_tau.
-    gstep. constructor; auto. rewrite interp_state_vis.
+ - rewrite H, H0.  rewrite interp_state_tau.
+    constructor; auto. rewrite interp_state_vis.
     specialize (Hhandler A e). inv Hhandler; try contradiction.
     red in RESCHECK. symmetry in Hs. apply RESCHECK in Hs as He.
     remember (handler A e s2) as t3. clear Heqt3.
-    cbn in He. generalize dependent t3. gcofix CIH'.
-    intros t3 Ht3. pinversion Ht3; use_simpobs; subst.
-    + destruct H4. cbn in *. destruct r1. cbn in *.
-      rewrite H2. rewrite bind_ret_l. gstep. constructor; auto.
-      gfinal. left. eapply CIH'0. eapply CIH; eauto. cbn. apply H1.
+    cbn in He. generalize dependent t3. accumulate CIH'.
+    intros t3 Ht3. sinv Ht3; use_simpobs; subst.
+    + destruct H4. destruct r1. cbn in *|-.
+      rewrite H2. rewrite bind_ret_l. constructor; auto.
+      eapply CIH; eauto. cbn. apply H1.
       symmetry. auto.
-    + rewrite H2. rewrite bind_tau. gstep; constructor; auto.
-      gfinal. left. eapply CIH'; eauto. symmetry in H3. use_simpobs.
+    + rewrite H2. rewrite bind_tau. constructor; auto.
+      eapply CIH'; eauto. symmetry in H3. use_simpobs.
       rewrite <- H3. auto.
-    + rewrite H2. rewrite bind_vis. gstep. constructor; auto.
-      intros. gfinal. left. eapply CIH'; eauto. symmetry in H3.
+    + rewrite H2. rewrite bind_vis. constructor; auto.
+      intros. eapply CIH'; eauto. symmetry in H3.
       use_simpobs. rewrite <- H3. apply H4.
- - pclearbot. rewrite H, H0. repeat rewrite interp_state_vis.
+ -  rewrite H, H0. repeat rewrite interp_state_vis.
    specialize (Hhandler A e1) as He1. specialize (Hhandler B e2) as He2.
    inv He1; inv He2; try contradiction.
-   eapply pi_secure_eqit_bind' with (RR := prod_rel RS top2); eauto.
-   + intros [? ?] [? ?] [? ?]. cbn in *. pstep. constructor.
-     right. eapply CIH; eauto. apply H1.
-   + cbn in *. apply pi_eqit_secure_RR_imp with
+   eapply pi_eqit_secure_bind with (RR := prod_rel RS top2); eauto.
+   + intros [? ?] [? ?] [? ?]. constructor.
+     eapply CIH; eauto. apply H1.
+   + apply pi_eqit_secure_RR_imp with
                    (RR1 := rcompose (prod_rel RS (@top2 A unit)) (prod_rel RS top2) ).
      { intros. inv H2. destruct REL1. destruct REL2. split; auto.
        etransitivity; eauto. }
-     eapply pi_eqit_secure_trans_ret; eauto.
+     cbn in *. eapply pi_eqit_secure_trans_ret; eauto.
      apply pi_eqit_secure_sym. apply pi_eqit_secure_RR_imp with
                                    (RR1 := prod_rel RS top2).
-     { intros. inv H2. split; auto. symmetry. auto.  }
+     { intros. inv H2.  }
      eapply RESCHECK0. reflexivity.
- - apply simpobs in H0. rewrite <- itree_eta in H0. rewrite H0.
-   rewrite H. rewrite interp_state_vis.
+ - apply simpobs in H0. rewrite <- itree_eta in H0. 
+   rewrite H. rewrite H0. rewrite interp_state_vis.
    specialize (Hhandler A e). inv Hhandler; try contradiction.
    red in RESCHECK. apply RESCHECK in Hs as He.
     remember (handler A e s1) as t3. clear Heqt3.
-    cbn in He. generalize dependent t3. gcofix CIH'.
-    intros t3 Ht3. pinversion Ht3; use_simpobs; subst.
+    (* TOUR: PROBLEM
+    The proof we want: 
+    cbn in He. generalize dependent t3. accumluate CIH'.
+    intros t3 Ht3. sinv Ht3; use_simpobs; subst.
     + destruct H4. cbn in *. destruct r1. cbn in *.
       rewrite H2. rewrite bind_ret_l. gstep. constructor; auto.
-      gfinal. left. eapply CIH; eauto. cbn. apply H1.
+      eapply CIH; eauto. cbn. apply H1.
     + rewrite H2. rewrite bind_tau. gstep; constructor; auto.
-      gfinal. left. eapply CIH'; eauto. symmetry in H3. use_simpobs.
+      eapply CIH'; eauto. symmetry in H3. use_simpobs.
       rewrite <- H3. auto.
     + rewrite H2. rewrite bind_vis. gstep. constructor; auto.
-      intros. gfinal. left. eapply CIH'; eauto. symmetry in H3.
+      intros. eapply CIH'; eauto. symmetry in H3.
       use_simpobs. rewrite <- H3. apply H4.
- - apply simpobs in H. rewrite <- itree_eta in H. rewrite H.
-   pclearbot. rewrite H0. rewrite interp_state_vis.
+
+      or coinduction instead of accumulate. problem: 
+      we are at b (elem c), not elem c, so we cannot use accumulate. 
+    *)
+    cbn in *|-. step in He. 
+    remember (observe (Ret (s2, tt))).
+    icbn. rewrite observe_bind. 
+    hinduction He before CIH; intros; try easy.
+    + inv H. inv Heqi. cbn in *. constructor; auto. cbn. 
+    eapply CIH; eauto. simpobs_subst. apply H1.  
+    + constructor 3; auto. step in H. rewrite Heqi in H. clear Heqi. 
+    generalize dependent t1. 
+    accumulate CIH'. 
+    intros t1 H. icbn.
+      rewrite observe_bind. inv H. 
+      * constructor; auto. 
+        inv H5. cbn in *. 
+        eapply CIH; eauto. apply H1. 
+      * constructor; auto. eapply CIH'. rewrite <- H4. rewrite <- itree_eta'. now unstep.  
+      * constructor; auto; intro. eapply CIH'; eauto. rewrite <- H4. rewrite <- itree_eta'. now unstep.  
+    + constructor 9; auto. intros.
+      rename t4 into t5. 
+      remember (k1 a) as t4.
+      specialize (H a). step in H. 
+      rewrite <- Heqt4 in H. clear Heqt4. 
+      generalize dependent t4. 
+      accumulate CIH'. 
+      intros t4 H.
+      icbn. rewrite observe_bind. 
+      dependent induction H; simpobs; try easy. 
+      * constructor; auto. 
+        inv H. inv Heqi. cbn in *. 
+        eapply CIH; eauto. apply H1. 
+      * constructor; auto. eapply CIH'. unstep. apply H.  
+      * constructor; auto; intro. eapply CIH'. unstep. apply H. 
+      
+ - apply simpobs in H. rewrite <- itree_eta in H. 
+   rewrite H0. rewrite H. rewrite interp_state_vis.
    specialize (Hhandler A e). inv Hhandler; try contradiction.
-    red in RESCHECK. symmetry in Hs. apply RESCHECK in Hs as He.
-    remember (handler A e s2) as t3. clear Heqt3.
-    cbn in He. generalize dependent t3. gcofix CIH'.
-    intros t3 Ht3. pinversion Ht3; use_simpobs; subst.
+   red in RESCHECK. symmetry in Hs. apply RESCHECK in Hs as He.
+    remember (handler A e s1) as t3. clear Heqt3.
+    (* TOUR: PROBLEM
+    The proof we want: 
+    cbn in He. generalize dependent t3. accumluate CIH'.
+    intros t3 Ht3. sinv Ht3; use_simpobs; subst.
     + destruct H4. cbn in *. destruct r1. cbn in *.
       rewrite H2. rewrite bind_ret_l. gstep. constructor; auto.
-      gfinal. left. cbn. eapply CIH; eauto. cbn. apply H1.
-      symmetry. auto.
+      eapply CIH; eauto. cbn. apply H1.
     + rewrite H2. rewrite bind_tau. gstep; constructor; auto.
-      gfinal. left. eapply CIH'; eauto. symmetry in H3. use_simpobs.
+      eapply CIH'; eauto. symmetry in H3. use_simpobs.
       rewrite <- H3. auto.
     + rewrite H2. rewrite bind_vis. gstep. constructor; auto.
-      intros. gfinal. left. eapply CIH'; eauto. symmetry in H3.
+      intros. eapply CIH'; eauto. symmetry in H3.
       use_simpobs. rewrite <- H3. apply H4.
-Qed.
 
+      or coinduction instead of accumulate. problem: 
+      we are at b (elem c), not elem c, so we cannot use accumulate. 
+    *)
+    cbn in *|-. step in He. 
+    remember (observe (Ret (s1, tt))).
+    icbn. rewrite observe_bind. 
+    hinduction He before CIH; intros; try easy.
+    + inv H. inv Heqi. cbn in *. constructor; auto. cbn. 
+    eapply CIH; eauto. simpobs_subst. apply H1. now symmetry.   
+    + constructor 4; auto. step in H. rewrite Heqi in H. clear Heqi. 
+    generalize dependent t1. 
+    accumulate CIH'. 
+    intros t1 H. icbn.
+      rewrite observe_bind. inv H. 
+      * constructor; auto. 
+        inv H5. cbn in *. 
+        eapply CIH; eauto. apply H1. now symmetry.  
+      * constructor; auto. eapply CIH'. rewrite <- H4. rewrite <- itree_eta'. now unstep.  
+      * constructor; auto; intro. eapply CIH'; eauto. rewrite <- H4. rewrite <- itree_eta'. now unstep.  
+    + constructor 10; auto. intros.
+      rename t4 into t5. 
+      remember (k1 a) as t4.
+      specialize (H a). step in H. 
+      rewrite <- Heqt4 in H. clear Heqt4. 
+      generalize dependent t4. 
+      accumulate CIH'. 
+      intros t4 H.
+      icbn. rewrite observe_bind. 
+      dependent induction H; simpobs; try easy. 
+      * constructor; auto. 
+        inv H. inv Heqi. cbn in *. 
+        eapply CIH; eauto. apply H1. now symmetry.  
+      * constructor; auto. eapply CIH'. unstep. apply H.  
+      * constructor; auto; intro. eapply CIH'. unstep. apply H. 
+Qed. 
 End GeneralStateHandler.
diff --git a/extra/Secure/StrongBisimProper.v b/extra/Secure/StrongBisimProper.v
index e10560ac..47c70f3f 100644
--- a/extra/Secure/StrongBisimProper.v
+++ b/extra/Secure/StrongBisimProper.v
@@ -1,4 +1,5 @@
-From Coq Require Import Morphisms.
+From Coinduction Require Import all. 
+From Stdlib Require Import Morphisms.
 
 From ITree Require Import
      ITree
@@ -6,14 +7,9 @@ From ITree Require Import
      Eq.EqAxiom
 .
 
-From Paco Require Import paco.
 
-(* Tau t ≈ t*)
-(* eqit_secure (Vis e k)  (k a) *)
-
-(* r => fun (f g : A -> B) => f = g*)
-Global Instance strong_bisim_proper_paco {E R1 R2 F r} :
-       Proper (@eq_itree E R1 R1 eq ==> @eq_itree E R2 R2 eq ==> flip impl) (paco2 F r).
+Global Instance strong_bisim_proper_chain {E R1 R2} b (c : Chain b) :
+       Proper (@eq_itree E R1 R1 eq ==> @eq_itree E R2 R2 eq ==> iff) (elem c).
 Proof.
   repeat intro. apply bisimulation_is_eq in H. apply bisimulation_is_eq in H0.
   subst. auto.
diff --git a/hoare_example/Imp.v b/hoare_example/Imp.v
index de66c30e..f37ee77c 100644
--- a/hoare_example/Imp.v
+++ b/hoare_example/Imp.v
@@ -39,7 +39,7 @@
 *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Arith.PeanoNat
      Lists.List
      Strings.String
diff --git a/hoare_example/ImpHoare.v b/hoare_example/ImpHoare.v
index b689f31b..24a70216 100644
--- a/hoare_example/ImpHoare.v
+++ b/hoare_example/ImpHoare.v
@@ -1,6 +1,8 @@
-From Coq Require Import
+From Coinduction Require Import all. 
+From Stdlib Require Import
      Arith Lia (* nia *)
      Morphisms
+     Program.Basics
 .
 
 From ExtLib Require Import
@@ -14,6 +16,7 @@ From ITree Require Import
      Events.MapDefault
      Events.State
      Events.StateFacts
+     HeterogeneousRelations
      Props.Infinite.
 
 From ITree.Extra Require Import
@@ -25,7 +28,6 @@ From ITree.Extra Require Import
      Dijkstra.StateDelaySpec
 .
 
-From Paco Require Import paco.
 
 From hoare Require Import Imp.
 
@@ -223,7 +225,7 @@ Qed.
 Definition state_eq2 {E : Type -> Type} {A B S : Type} (k1 k2 : A -> stateT S (itree E) B ) : Prop :=
   forall a, state_eq (k1 a)  (k2 a).
 
-Lemma eq_itree_clo_bind {E : Type -> Type} {R1 R2 : Type} :
+Lemma eq_itree_bind {E : Type -> Type} {R1 R2 : Type} :
   forall (RR : R1 -> R2 -> Prop) (U1 U2 : Type) (UU : U1 -> U2 -> Prop)
          (t1 : itree E U1) (t2 : itree E U2)
          (k1 : U1 -> itree E R1) (k2 : U2 -> itree E R2),
@@ -239,7 +241,7 @@ Global Instance bind_state_eq2 {E : Type -> Type} {A B S : Type} {m : stateT S (
   Proper (@state_eq2 E A B S ==> @state_eq E S B) (bind m).
 Proof.
   repeat intro. unfold state_eq2, state_eq in H. cbn.
-  eapply eq_itree_clo_bind; try reflexivity. intros. subst.
+  eapply eq_itree_bind; try reflexivity. intros. subst.
   destruct u2 as [s' a]. simpl. rewrite H. reflexivity.
 Qed.
 
@@ -268,7 +270,7 @@ Proof.
     fold (run_state_itree s while_denote1). fold (run_state_itree s while_denote2).
     unfold while_denote1. unfold while_denote2. rewrite H. reflexivity.
  - rewrite interp_bind. rewrite interp_state_bind_state.
-   clear s. intro s. eapply eq_itree_clo_bind; try reflexivity.
+   clear s. intro s. eapply eq_itree_bind; try reflexivity.
    intros. subst. destruct u2 as [s' b0 ]. simpl. destruct b0.
    + rewrite interp_bind. rewrite interp_state_bind.
      unfold interp_imp, interp_map. reflexivity.
@@ -328,14 +330,14 @@ Proof.
     }
    enough (p (Ret (s',tt) ) ).
     {
-      unfold p in H0. basic_solve; auto. pinversion H0.
+      unfold p in H0. basic_solve; auto. sinv H0.
     }
     enough (p (CategoryOps.iter body tt s) ).
     {
       eapply Hp; try apply H0. unfold CategoryOps.iter, Iter_Kleisli, Basics.iter.
       unfold body. symmetry. auto.
     }
-    enough ((p \1/ any_infinite) (CategoryOps.iter body tt s) ).
+    enough ((Disj_unary _ p any_infinite) (CategoryOps.iter body tt s) ).
     {
       destruct H0; auto. unfold p. auto.
     }
@@ -358,7 +360,7 @@ Proof.
         eapply Hq.
         -- cbn. rewrite H1. setoid_rewrite bind_bind. setoid_rewrite bind_ret_l.
            simpl. tau_steps. reflexivity.
-        -- unfold q. left. exists s. right. split; auto. reflexivity.
+        -- unfold q. left. exists s. right. split; auto.
       * do 2 red in H1. unfold interp_imp, interp_map in H1.
         eapply Hq.
         -- cbn. rewrite H1. setoid_rewrite bind_bind. setoid_rewrite bind_ret_l.
@@ -382,7 +384,7 @@ Proof.
        exists s0. split; auto. symmetry. auto.
      * right. destruct (eutt_reta_or_div t); basic_solve; auto.
        cbn in H0. rewrite <- H1 in H0. setoid_rewrite bind_ret_l in H0.
-       pinversion H0.
+       sinv H0.
   + unfold q.
     unfold DelaySpecMonad.iter_lift, iso_destatify_arrow, reassoc.
     basic_solve; try (destruct (classic_bool b s0) );
@@ -404,22 +406,22 @@ Proof.
       -- cbn.  rewrite H0. setoid_rewrite bind_ret_l.
          do 2 red in H1. unfold interp_imp, interp_map in H1. rewrite H1.
          setoid_rewrite bind_bind. setoid_rewrite bind_ret_l. simpl. tau_steps. reflexivity.
-      -- left. exists s0. right. split; auto. reflexivity.
+      -- left. exists s0. right. split; auto; reflexivity.
     * eapply Hq.
       -- cbn.  rewrite H0. setoid_rewrite bind_ret_l.
          do 2 red in H1. unfold interp_imp, interp_map in H1. rewrite H1.
          setoid_rewrite bind_bind. setoid_rewrite bind_ret_l. simpl. tau_steps. reflexivity.
-      -- left. exists s0. right. split; auto. reflexivity.
+      -- left. exists s0. right. split; auto; reflexivity.
     * do 2 red in H1. do 2 red in H2. rewrite H1 in H2.
       apply eutt_inv_Ret in H2. injection H2. discriminate.
     * do 2 red in H1. do 2 red in H2. rewrite H1 in H2.
       apply eutt_inv_Ret in H2. injection H2. discriminate.
     * eapply Hq.
       -- cbn.  rewrite H0. setoid_rewrite bind_ret_l.  reflexivity.
-      -- left. exists s0. right. split; auto. reflexivity.
+      -- left. exists s0. right. split; auto; reflexivity.
     * eapply Hq.
       -- cbn.  rewrite H0. setoid_rewrite bind_ret_l.  reflexivity.
-      -- left. exists s0. right. split; auto. reflexivity.
+      -- left. exists s0. right. split; auto; reflexivity.
     * right. cbn. apply div_spin_eutt in H0. rewrite H0. rewrite <- spin_bind.
       apply spin_infinite.
    - set (fun (t : Delay (env * unit)) =>
@@ -449,14 +451,14 @@ Proof.
 
       enough (p (Ret (s',tt))).
       {
-        unfold p in H0. basic_solve; auto. pinversion H0.
+        unfold p in H0. basic_solve; auto. sinv H0.
       }
-      enough ((p \1/ any_infinite) (CategoryOps.iter body tt s ) ).
+      enough ((Disj_unary _ p any_infinite) (CategoryOps.iter body tt s ) ).
       {
         destruct H0.
         - eapply Hp; try apply H0. rewrite <- Heutt. reflexivity.
         - unfold CategoryOps.iter, Iter_Kleisli, Basics.iter in H0.
-          unfold body in H0. rewrite Heutt in H0. pinversion H0.
+          unfold body in H0. rewrite Heutt in H0. sinv H0.
       }
       eapply Hloop; eauto.
       + unfold reassoc. unfold body. destruct (classic_bool b s).
@@ -483,7 +485,7 @@ Proof.
           eapply Hq.
           -- setoid_rewrite bind_bind. rewrite H0. setoid_rewrite bind_ret_l.
              simpl. cbn. tau_steps. reflexivity.
-          -- unfold q. left. exists s. split; auto. right. reflexivity.
+          -- unfold q. left. exists s. split; auto; try (right; reflexivity).
       + red. intros. unfold p. unfold q in H0. basic_solve.
         * cbn in H0.
           destruct (eutt_reta_or_div t); basic_solve.
@@ -500,7 +502,7 @@ Proof.
            rewrite <- spin_bind in H0. symmetry in H0. apply not_ret_eutt_spin in H0. auto.
       * cbn in H0. right. destruct (eutt_reta_or_div t); auto.
         basic_solve. rewrite <- H1 in H0. setoid_rewrite bind_ret_l in H0.
-        pinversion H0.
+        sinv H0.
     + unfold DelaySpecMonad.iter_lift, iso_destatify_arrow, reassoc.
       intros t Ht. cbn.
       destruct (eutt_reta_or_div t);
@@ -518,10 +520,10 @@ Proof.
         -- destruct a as [s3 [] ]. unfold q in Ht. basic_solve.
            ++ rewrite  H3 in H0. basic_solve.
               unfold q. left. exists s3. split; try (left; reflexivity). symmetry in H2.
-              cbn in H0. pinversion H0. subst. injection REL; intros; subst.
+              cbn in H0. sinv H0. subst. injection REL; intros; subst.
               eapply H; eauto.
-           ++ rewrite H3 in H0. cbn in *; basic_solve; pinversion H0; try discriminate; basic_solve.
-           ++ rewrite <- H0 in H3. pinversion H3.
+           ++ rewrite H3 in H0. cbn in *; basic_solve; sinv H0; try discriminate; basic_solve.
+           ++ rewrite <- H0 in H3. sinv H3.
         -- rewrite <- H0. setoid_rewrite bind_ret_l. setoid_rewrite bind_bind.
            do 2 red in H1. unfold interp_imp, interp_map in H1. rewrite H1.
            setoid_rewrite bind_ret_l. simpl. apply div_spin_eutt in H2.
@@ -534,9 +536,9 @@ Proof.
            tau_steps. reflexivity.
         -- unfold q. left. exists s''. split; try (right; reflexivity). unfold q in Ht.
            basic_solve.
-           ++ rewrite H3 in H0. basic_solve. auto. pinversion H0. injection REL; intros; subst; auto.
-           ++ rewrite H3 in H0. basic_solve. pinversion H0. discriminate.
-           ++ rewrite <- H0 in H3. pinversion H3.
+           ++ rewrite H3 in H0. basic_solve. auto. sinv H0. injection REL; intros; subst; auto.
+           ++ rewrite H3 in H0. basic_solve. sinv H0; try discriminate.
+           ++ rewrite <- H0 in H3. sinv H3.
         -- rewrite <- H0. setoid_rewrite bind_ret_l.
            setoid_rewrite bind_bind.
            do 2 red in H1. unfold interp_imp, interp_map in H1.
@@ -545,17 +547,17 @@ Proof.
         -- unfold q. left. exists s''.
            split; try (right; reflexivity). unfold q in Ht.
            basic_solve.
-           ++ rewrite H3 in H0. basic_solve. pinversion H0; injection REL; intros; subst; auto.
-           ++ rewrite H3 in H0. basic_solve. pinversion H0; discriminate.
-           ++ rewrite <- H0 in H3. pinversion H3.
+           ++ rewrite H3 in H0. basic_solve. sinv H0; injection REL; intros; subst; auto.
+           ++ rewrite H3 in H0. basic_solve. sinv H0; discriminate.
+           ++ rewrite <- H0 in H3. sinv H3.
      * destruct b0 as [s'' [] ]. eapply Hq.
        -- rewrite <- H0. setoid_rewrite bind_ret_l.
           reflexivity.
        -- unfold q. left. exists s''. split; try (right; reflexivity).
           unfold q in Ht. basic_solve.
-          ++ rewrite H1 in H0. basic_solve. pinversion H0. discriminate.
-          ++ rewrite H1 in H0. basic_solve. pinversion H0; injection REL; intros; subst; auto.
-          ++ rewrite <- H0 in H1. pinversion H1.
+          ++ rewrite H1 in H0. basic_solve. sinv H0; try discriminate.
+          ++ rewrite H1 in H0. basic_solve. sinv H0; injection REL; intros; subst; auto.
+          ++ rewrite <- H0 in H1. sinv H1.
      * clear Ht. unfold q. right. apply div_spin_eutt in H0.
        rewrite H0. rewrite <- spin_bind. apply spin_infinite.
 
@@ -564,7 +566,7 @@ Qed.
 Lemma denote_imp_bind : forall (c1 c2 : com), state_eq (denote_imp (c1 ;;; c2)) (denote_imp c1 ;; denote_imp c2).
 Proof.
   intros. intro. cbn. unfold denote_imp. simpl. setoid_rewrite interp_imp_bind.
-  eapply eq_itree_clo_bind; try reflexivity. intros. subst. destruct u2. reflexivity.
+  eapply eq_itree_bind; try reflexivity. intros. subst. destruct u2. reflexivity.
 Qed.
 
 Definition state_eq_eutt {R S : Type} {E : Type -> Type} (m0 m1 : stateT S (itree E) R) :Prop :=
@@ -720,7 +722,7 @@ Global Instance state_eutt_bind_r {A B S : Type} {E : Type -> Type}
 Proof.
   repeat intro. rename x into k0. rename y into k1. rename H into Heutt.
   red. red. red in Heutt. red in Heutt. cbn.
-  eapply eutt_clo_bind; try reflexivity. intros. subst. destruct u2 as [s' a]. simpl.
+  eapply eutt_bind_eutt; try reflexivity. intros. subst. destruct u2 as [s' a]. simpl.
   rewrite Heutt. reflexivity.
 Qed.
 
@@ -729,7 +731,7 @@ Global Instance state_eutt_bind_l' {A B S : Type} {E : Type -> Type} :
 Proof.
   unfold Proper, respectful, pointwise_relation. intros m0 m1 Hmeutt k0 k1 Hkeutt.
   intro. cbn. red in Hmeutt. rewrite Hmeutt.
-  eapply eutt_clo_bind; try reflexivity. intros. subst. destruct u2 as [s' a].
+  eapply eutt_bind_eutt; try reflexivity. intros. subst. destruct u2 as [s' a].
   simpl. red in Hkeutt. rewrite Hkeutt. reflexivity.
 Qed.
 
@@ -887,8 +889,8 @@ Section SQRTEx.
     eapply intro_not_wf with (P := fun s => lookup_default n 0 s = n0) (f := fun s => inc_var i s); auto.
     - intros s0 s1 Hinv Heval. unfold body_arrow in Heval. simpl in Heval.
       rewrite Hinv in Heval. eqbdestruct (lookup_default i 0 s0 * lookup_default i 0 s0) n0.
-      + simpl in *. basic_solve. pinversion Heval; discriminate.
-      + simpl in Heval. basic_solve. pinversion Heval. injection REL; intros; subst. unfold inc_var. rewrite lookup_neq; auto.
+      + simpl in *. basic_solve. sinv Heval; discriminate.
+      + simpl in Heval. basic_solve. sinv Heval. injection REL; intros; subst. unfold inc_var. rewrite lookup_neq; auto.
     - intros s' Hinv. unfold body_arrow. simpl. rewrite Hinv.
       eqbdestruct (lookup_default i 0 s' * lookup_default i 0 s') n0; simpl.
       + exfalso. eapply H; apply Heq.
@@ -909,14 +911,14 @@ Section SQRTEx.
       unfold body_arrow in Heutt. simpl in Heutt.
       destruct Hs1 as [Hsqrt1 Hconst].
       eqbdestruct (lookup_default i 0 s1 * lookup_default i 0 s1) (lookup_default n 0 s1);
-        simpl in *; basic_solve; pinversion Heutt; try discriminate; injection REL; intros; subst.
+        simpl in *; basic_solve; sinv Heutt; try discriminate; injection REL; intros; subst.
       split.
       + unfold inc_var. rewrite lookup_eq.
         nia.
       + unfold inc_var. rewrite lookup_neq; auto.
     - intros s1 s2 Hs1 Heutt. unfold body_arrow in Heutt. simpl in *.
       eqbdestruct (lookup_default i 0 s1 * lookup_default i 0 s1) (lookup_default n 0 s1); simpl in *;
-        pinversion Heutt; try discriminate; injection REL; intros; subst.
+        sinv Heutt; try discriminate; injection REL; intros; subst.
         unfold inc_var. rewrite lookup_eq. nia.
     - split; nia.
  Qed.
@@ -937,11 +939,11 @@ Section SQRTEx.
       rewrite compile_nat_sqrt_body. unfold run_state_itree.
       apply iter_inl_spin_state.
       apply ( diverge_if_not_square_nat_sqrt_aux) in H. unfold state_iter_arrow_rel.
-      simpl. unfold body_arrow in H. simpl in *. generalize dependent s. pcofix CIH. intros.
-      pinversion H0; try apply not_wf_F_mono'.
-      pfold. eapply not_wf with (a' := (a',tt)).
+      simpl. unfold body_arrow in H. simpl in *. generalize dependent s. coinduction c CIH. intros.
+      sinv H; try apply not_wf_F_mono'.
+      eapply not_wf with (a' := (a',tt)).
       - symmetry. auto.
-      - right. auto.
+      - apply CIH; auto.
     Qed.
 
     (*maybe there is a better way to do it, prove that if the body can't prove a a spin,
@@ -980,7 +982,7 @@ Section SQRTEx.
 
 
   Lemma prepost1_holds_nat_sqrt_loop :
-    verify_cond env (encode_dyn env ((pre1 /1\ fun s => lookup_default i 0 s = 0), post1) )
+    verify_cond env (encode_dyn env ((Conj_unary _ pre1 (fun s => lookup_default i 0 s = 0), post1) ))
                 (denote_imp (WHILE (~ i * i  = n) DO i ::= i + 1 END)%imp ).
   Proof.
     rewrite compile_nat_sqrt_body.
@@ -1008,13 +1010,13 @@ Section SQRTEx.
         * exists s0. split; auto. left. rewrite H. auto.
         * exists s0. split; auto. right. rewrite H. auto.
     }
-    match goal with |- p ?t => enough ((p \1/ any_infinite) t)  end.
+    match goal with |- p ?t => enough ((Disj_unary _ p any_infinite) t)  end.
     - destruct H; auto. exfalso.
       specialize (converge_if_square_nat_sqrt s Hi0 Hpre) as Hconv.
       basic_solve.
       match type of Hconv with ?m s ≈ _ => fold (run_state_itree s m) in Hconv end.
       rewrite compile_nat_sqrt_body in Hconv. unfold run_state_itree in Hconv. rewrite Hconv in H.
-      pinversion H.
+      sinv H.
     - eapply loop_invar_state with (q := q); eauto.
       (*Establishment*)
       + unfold reassoc. simpl. rewrite Hi0. simpl.
@@ -1061,7 +1063,7 @@ Section SQRTEx.
                 ** unfold get, inc_var. rewrite lookup_neq; auto.
          * eapply Hq.
            -- rewrite H. simpl. rewrite bind_ret_l. cbn. reflexivity.
-           -- red. exists s0. split; auto. right. split; auto. reflexivity.
+           -- red. exists s0. split; auto; try (right; split; auto; reflexivity).
   Qed.
 
 
diff --git a/hoare_example/ImpIO.v b/hoare_example/ImpIO.v
index 1af468d4..b6dfa543 100644
--- a/hoare_example/ImpIO.v
+++ b/hoare_example/ImpIO.v
@@ -1,4 +1,4 @@
-From Coq Require Import String.
+From Stdlib Require Import String.
 
 Inductive aexp :=
   | AId : string -> aexp
diff --git a/secure_example/CatTheory.v b/secure_example/CatTheory.v
index 819b80e8..dc2bc761 100644
--- a/secure_example/CatTheory.v
+++ b/secure_example/CatTheory.v
@@ -1,5 +1,5 @@
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Morphisms.
 
 From ITree Require Import
diff --git a/secure_example/Fin.v b/secure_example/Fin.v
index 37d7f3c4..75ff461e 100644
--- a/secure_example/Fin.v
+++ b/secure_example/Fin.v
@@ -14,7 +14,7 @@
    [Fun] and [ktree] on finite types (instead of arbitrary types). *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Arith
      Lia.
 
diff --git a/secure_example/KTreeFin.v b/secure_example/KTreeFin.v
index 91b610ff..fe239200 100644
--- a/secure_example/KTreeFin.v
+++ b/secure_example/KTreeFin.v
@@ -6,7 +6,7 @@
  *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Setoid
      Morphisms.
 
diff --git a/secure_example/LabelledAsm.v b/secure_example/LabelledAsm.v
index 27eb5eb9..605bab2e 100644
--- a/secure_example/LabelledAsm.v
+++ b/secure_example/LabelledAsm.v
@@ -5,7 +5,7 @@
     by jumps.  *)
 
 (* begin hide *)
-From Coq Require Import Arith String Setoid.
+From Stdlib Require Import Arith String Setoid.
 
   (* SAZ: Should we add ITreeMonad to ITree? *)
 From ITree Require Import
diff --git a/secure_example/LabelledAsmCombinators.v b/secure_example/LabelledAsmCombinators.v
index a876c0a4..e3b87049 100644
--- a/secure_example/LabelledAsmCombinators.v
+++ b/secure_example/LabelledAsmCombinators.v
@@ -20,7 +20,7 @@
  *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Arith
      List
      Program.Basics
diff --git a/secure_example/LabelledAsmHandler.v b/secure_example/LabelledAsmHandler.v
index 65c685d1..a545c3e8 100644
--- a/secure_example/LabelledAsmHandler.v
+++ b/secure_example/LabelledAsmHandler.v
@@ -1,4 +1,4 @@
-From Coq Require Import
+From Stdlib Require Import
      List
      Morphisms.
 
@@ -19,8 +19,6 @@ Import Monads.
 Import MonadNotation.
 Local Open Scope monad_scope.
 
-From Paco Require Import paco.
-
 (* Note that this definition sets considers all registers to be private *)
 
 Definition priv_asm (priv : privacy_map sensitivity_lat) (A : Type) (e : (Reg +' Memory +' (IOE sensitivity_lat)) A ) :=
diff --git a/secure_example/LabelledImp.v b/secure_example/LabelledImp.v
index 9f1e5391..e7ce5460 100644
--- a/secure_example/LabelledImp.v
+++ b/secure_example/LabelledImp.v
@@ -1,4 +1,4 @@
-From Coq Require Import String.
+From Stdlib Require Import String.
 
 From ITree Require Import
      ITree
diff --git a/secure_example/LabelledImp2Asm.v b/secure_example/LabelledImp2Asm.v
index 3c0def83..63e403de 100644
--- a/secure_example/LabelledImp2Asm.v
+++ b/secure_example/LabelledImp2Asm.v
@@ -17,7 +17,7 @@
 *)
 
 (* begin hide *)
-From Coq Require Import List.
+From Stdlib Require Import List.
 Import ListNotations.
 
 From ITree Require Import ITree.
diff --git a/secure_example/LabelledImp2AsmCorrectness.v b/secure_example/LabelledImp2AsmCorrectness.v
index fd0a327e..1f25afad 100644
--- a/secure_example/LabelledImp2AsmCorrectness.v
+++ b/secure_example/LabelledImp2AsmCorrectness.v
@@ -53,7 +53,7 @@ SAZ: This needs to be updated.
 
 (* begin hide *)
 
-From Coq Require Import
+From Stdlib Require Import
      Lia
      Arith
      String
@@ -346,7 +346,7 @@ Section Bisimulation.
   Proof.
     repeat intro. unfold interp_asm, interp_imp.
     repeat rewrite interp_state_bind.
-    eapply eutt_clo_bind.
+    eapply eutt_bind_eutt.
     { eapply H; auto. }
     intros [s1 a] [ [regs mem] a'].
     intros Hs. destruct Hs.
@@ -371,7 +371,7 @@ Section Bisimulation.
     2 : { split; auto. }
     destruct H3. destruct j1 as [s1 a].
     destruct j2 as [ [regs1 mem1] a']. cbn in *.
-    eapply eutt_clo_bind; eauto. intros [s2 r1] [ [regs2 mem2 ] r2 ] Hs.
+    eapply eutt_bind_eutt; eauto. intros [s2 r1] [ [regs2 mem2 ] r2 ] Hs.
     red in Hs. cbn in *. destruct Hs as [Hs Hr].
     inv Hr;
     apply eqit_Ret; constructor; split; auto.
@@ -660,9 +660,9 @@ Section Linking.
     rewrite bind_ret_l.
     destruct (label_case x); cbn.
     - rewrite !bind_bind. setoid_rewrite bind_ret_l. setoid_rewrite bind_bind.
-      eapply eutt_clo_bind; try reflexivity. intros; subst.
+      eapply eutt_bind_eutt; try reflexivity. intros; subst.
       repeat rewrite bind_bind.
-      eapply eutt_clo_bind; try reflexivity. intros; subst.
+      eapply eutt_bind_eutt; try reflexivity. intros; subst.
       unfold from_bif, FromBifunctor_ktree_fin; cbn.
       repeat rewrite bind_bind.
       repeat setoid_rewrite bind_ret_l.
@@ -675,7 +675,7 @@ Section Linking.
       + rewrite (relabel_asm_correct _ _ _ _). cbn.
         rewrite bind_ret_l.
         setoid_rewrite bind_bind.
-        eapply eutt_clo_bind; try reflexivity.
+        eapply eutt_bind_eutt; try reflexivity.
         intros ? ? [].
         repeat rewrite bind_ret_l.
         apply eqit_Ret.
@@ -870,12 +870,12 @@ Section Correctness.
       repeat setoid_rewrite interp_state_bind.
 
       (* The Induction hypothesis on [e1] relates the first itrees *)
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe1; assumption. }
       (* We obtain new related environments *)
       intros [g_imp' v] [ [g_asm' l'] [] ]    HSIM.
       (* The Induction hypothesis on [e2] relates the second itrees *)
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe2.
         eapply sim_rel_Renv; eassumption. }
       (* And we once again get new related environments *)
@@ -899,12 +899,12 @@ Section Correctness.
       repeat setoid_rewrite interp_state_bind.
 
       (* The Induction hypothesis on [e1] relates the first itrees *)
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe1; assumption. }
       (* We obtain new related environments *)
       intros [g_imp' v] [ [g_asm' l'] [] ]    HSIM.
       (* The Induction hypothesis on [e2] relates the second itrees *)
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe2.
         eapply sim_rel_Renv; eassumption. }
       (* And we once again get new related environments *)
@@ -928,12 +928,12 @@ Section Correctness.
       repeat setoid_rewrite interp_state_bind.
 
       (* The Induction hypothesis on [e1] relates the first itrees *)
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe1; assumption. }
       (* We obtain new related environments *)
       intros [g_imp' v] [ [g_asm' l'] [] ]    HSIM.
       (* The Induction hypothesis on [e2] relates the second itrees *)
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe2.
         eapply sim_rel_Renv; eassumption. }
       (* And we once again get new related environments *)
@@ -970,7 +970,7 @@ Section Correctness.
     (* By correctness of the compilation of expressions,
        we can match the head trees.
      *)
-    eapply eutt_clo_bind.
+    eapply eutt_bind_eutt.
     { eapply compile_expr_correct; eauto. }
 
     (* Once again, we get related environments *)
@@ -995,7 +995,7 @@ Section Correctness.
     red. intros. unfold compile_output. unfold interp_imp, interp_asm.
     rewrite denote_list_app.
     do 2 rewrite interp_state_bind.
-    eapply eutt_clo_bind.
+    eapply eutt_bind_eutt.
     { eapply compile_expr_correct; eauto. }
     intros [g_imp' v]  [ [g_asm' l'] y] HSIM.
     simpl in HSIM. cbn.
@@ -1037,7 +1037,7 @@ Section Correctness.
     rewrite unfold_iter_ktree.
     rewrite unfold_iter.
     rewrite !bind_bind.
-    eapply eutt_clo_bind. reflexivity.
+    eapply eutt_bind_eutt. reflexivity.
     intros. subst.
     destruct u2 as [[]|[]].
     2 : { force_right. reflexivity. }
@@ -1046,7 +1046,7 @@ Section Correctness.
     apply eutt_iter' with (RI := fun _ r => inl tt = r).
     - intros _ _ [].
       rewrite <- bind_ret_r at 1.
-      eapply eutt_clo_bind; try reflexivity.
+      eapply eutt_bind_eutt; try reflexivity.
       intros [|[]] _ []; apply eqit_Ret; auto; constructor; auto.
     - constructor.
   Qed.
@@ -1082,19 +1082,19 @@ Section Correctness.
       reflexivity.
     - simpl. rewrite bind_bind. setoid_rewrite bind_bind. rewrite throw_prefix_bind.
       rewrite IHe1. rewrite bind_bind. setoid_rewrite bind_ret_l.
-      eapply eutt_clo_bind; try reflexivity. intros; subst.
+      eapply eutt_bind_eutt; try reflexivity. intros; subst.
       rewrite throw_prefix_bind. rewrite IHe2. rewrite bind_bind.
       setoid_rewrite bind_ret_l. setoid_rewrite throw_prefix_ret.
       reflexivity.
     - simpl. rewrite bind_bind. setoid_rewrite bind_bind. rewrite throw_prefix_bind.
       rewrite IHe1. rewrite bind_bind. setoid_rewrite bind_ret_l.
-      eapply eutt_clo_bind; try reflexivity. intros; subst.
+      eapply eutt_bind_eutt; try reflexivity. intros; subst.
       rewrite throw_prefix_bind. rewrite IHe2. rewrite bind_bind.
       setoid_rewrite bind_ret_l. setoid_rewrite throw_prefix_ret.
       reflexivity.
     -  simpl. rewrite bind_bind. setoid_rewrite bind_bind. rewrite throw_prefix_bind.
       rewrite IHe1. rewrite bind_bind. setoid_rewrite bind_ret_l.
-      eapply eutt_clo_bind; try reflexivity. intros; subst.
+      eapply eutt_bind_eutt; try reflexivity. intros; subst.
       rewrite throw_prefix_bind. rewrite IHe2. rewrite bind_bind.
       setoid_rewrite bind_ret_l. setoid_rewrite throw_prefix_ret.
       reflexivity.
@@ -1154,7 +1154,7 @@ Section Correctness.
       cbn. rewrite throw_prefix_bind. rewrite <- fold_to_itree'.
       rewrite throw_prefix_denote_expr. rewrite bind_bind. setoid_rewrite bind_ret_l.
       red. intros. unfold interp_imp, interp_asm. do 2 rewrite interp_state_bind.
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply compile_expr_correct; eauto. }
       intros. destruct u1 as [s v]. destruct u2 as [ [reg mem] ?  ]. destruct u.
       cbn. assert (Htmp : reg 0 = v).
@@ -1182,7 +1182,7 @@ Section Correctness.
         repeat rewrite bind_bind. setoid_rewrite bind_bind. setoid_rewrite bind_ret_l.
         red. intros.
         unfold interp_asm, interp_imp.
-        do 2 rewrite interp_state_bind. eapply eutt_clo_bind.
+        do 2 rewrite interp_state_bind. eapply eutt_bind_eutt.
         {  eapply compile_expr_correct; auto. }
         intros [m v] [ [reg mem] [] ]. cbn.
         intros [HRenv [ Hreg0  ? ] ].
@@ -1196,7 +1196,7 @@ Section Correctness.
         * repeat setoid_rewrite bind_bind. setoid_rewrite throw_prefix_bind.
           setoid_rewrite bind_bind. rewrite bind_trigger. rewrite interp_state_vis.
           cbn. setoid_rewrite bind_ret_l. rewrite tau_eutt. cbn. unfold get_reg, tmp_if. rewrite Hreg0.
-          setoid_rewrite bind_bind. do 2 rewrite interp_state_bind. eapply eutt_clo_bind.
+          setoid_rewrite bind_bind. do 2 rewrite interp_state_bind. eapply eutt_bind_eutt.
           { apply IHs. auto. }
           intros [ st [ [] | [ | ] ] ] [ [reg' mem' ] l' ] Hst.
           -- cbn. setoid_rewrite bind_ret_l. setoid_rewrite throw_prefix_ret.
diff --git a/secure_example/LabelledImp2AsmNoninterferencePres.v b/secure_example/LabelledImp2AsmNoninterferencePres.v
index 3362ba29..b2cbc9c2 100644
--- a/secure_example/LabelledImp2AsmNoninterferencePres.v
+++ b/secure_example/LabelledImp2AsmNoninterferencePres.v
@@ -1,4 +1,5 @@
-From Coq Require Import Program.Basics Morphisms.
+From Coinduction Require Import all. 
+From Stdlib Require Import Program.Basics Morphisms.
 
 From ITree Require Import
      ITree
@@ -107,27 +108,22 @@ Lemma compile_preserves_ps_ni : forall (c : stmt _),
              eqit_secure _ (priv_exc_io _) (product_rel asm_eq eq) true true l
              (interp_asm (denote_asm (compile c) f0) σ1) ((interp_asm (denote_asm (compile c) f0)) σ2).
 Proof.
-  intros c Hsecc [regs1 mem1] [regs2 mem2]. intros Hasmeq.
-  assert (labelled_equiv _ Γ l mem1 mem1). reflexivity.
-  assert (labelled_equiv _ Γ l mem2 mem2). reflexivity.
-  specialize (compile_correct c) as Heutt. do 2 red in Heutt.
-  assert (Renv mem1 mem1). reflexivity.
-  assert (Renv mem2 mem2). reflexivity.
+  intros c Hsecc [regs1 mem1] [regs2 mem2] Hasmeq.
   do 2 red in Hsecc.
-  assert (Hmem12 : labelled_equiv _ Γ l mem1 mem2). auto.
+  assert (Hmem12 : labelled_equiv _ Γ l mem1 mem2) by auto.
   specialize (Hsecc mem1 mem2 Hmem12) as Hsecc'.
-  specialize (Heutt mem1 mem1 regs1 H1) as Heutt1.
-  specialize (Heutt mem2 mem2 regs2 H2) as Heutt2.
-  specialize (eutt_secure_eqit_secure) as Htrans.
-  eapply Htrans in Heutt1 as Heutt1'; eauto.
-  eapply Htrans in Heutt2 as Heutt2'; eauto.
-  eapply Htrans in Hsecc'; eauto.
-  apply eqit_secure_sym in Hsecc'.
-  eapply Htrans in Hsecc'; eauto.
-  apply eqit_secure_sym in Hsecc'.
-  eapply SecureEqEuttHalt.eqit_secure_RR_imp; try apply Hsecc'; eauto.
-  intros.
-  apply state_rel_aux'; auto.
+  specialize (compile_correct c) as Heutt. do 2 red in Heutt.
+  assert (HRenv1 : Renv mem1 mem1) by reflexivity.
+  assert (HRenv2 : Renv mem2 mem2) by reflexivity.
+  specialize (Heutt mem1 mem1 regs1 HRenv1) as Heutt1.
+  specialize (Heutt mem2 mem2 regs2 HRenv2) as Heutt2.
+  pose proof (eutt_secure_eqit_secure _ _ _ _ _ _ _
+                (product_rel (labelled_equiv sensitivity_lat Γ l) (@eq unit))
+                _ _ _ _ Hsecc' Heutt2) as Hcomp1.
+  apply eqit_secure_sym in Hcomp1.
+  pose proof (eutt_secure_eqit_secure _ _ _ _ _ _ _ _ _ _ _ _ Hcomp1 Heutt1) as Hcomp2.
+  apply eqit_secure_sym in Hcomp2.
+  eapply SecureEqEuttHalt.eqit_secure_RR_imp; [ apply state_rel_aux' | apply Hcomp2 ].
 Qed.
 
 
@@ -164,27 +160,22 @@ Lemma compile_preserves_pi_ni : forall (c : stmt _),
              pi_eqit_secure _ (priv_exc_io _) (product_rel asm_eq eq) true true l
              (interp_asm (denote_asm (compile c) f0) σ1) ((interp_asm (denote_asm (compile c) f0)) σ2).
 Proof.
-  intros c Hsecc [regs1 mem1] [regs2 mem2]. intros Hasmeq.
-  assert (labelled_equiv _ Γ l mem1 mem1). reflexivity.
-  assert (labelled_equiv _ Γ l mem2 mem2). reflexivity.
-  specialize (compile_correct c) as Heutt. do 2 red in Heutt.
-  assert (Renv mem1 mem1). reflexivity.
-  assert (Renv mem2 mem2). reflexivity.
+  intros c Hsecc [regs1 mem1] [regs2 mem2] Hasmeq.
   do 2 red in Hsecc.
-  assert (Hmem12 : labelled_equiv _ Γ l mem1 mem2). auto.
+  assert (Hmem12 : labelled_equiv _ Γ l mem1 mem2) by auto.
   specialize (Hsecc mem1 mem2 Hmem12) as Hsecc'.
-  specialize (Heutt mem1 mem1 regs1 H1) as Heutt1.
-  specialize (Heutt mem2 mem2 regs2 H2) as Heutt2.
-  specialize (pi_eqit_secure_mixed_trans) as Htrans.
-  eapply Htrans in Heutt1 as Heutt1'; eauto.
-  eapply Htrans in Heutt2 as Heutt2'; eauto.
-  eapply Htrans in Hsecc'; eauto.
-  apply pi_eqit_secure_sym in Hsecc'.
-  eapply Htrans in Hsecc'; eauto.
-  apply pi_eqit_secure_sym in Hsecc'.
-  eapply pi_eqit_secure_RR_imp; try apply Hsecc'; eauto.
-  intros.
-  apply state_rel_aux'; auto.
+  specialize (compile_correct c) as Heutt. do 2 red in Heutt.
+  assert (HRenv1 : Renv mem1 mem1) by reflexivity.
+  assert (HRenv2 : Renv mem2 mem2) by reflexivity.
+  specialize (Heutt mem1 mem1 regs1 HRenv1) as Heutt1.
+  specialize (Heutt mem2 mem2 regs2 HRenv2) as Heutt2.
+  pose proof (pi_eqit_secure_mixed_trans _ _ _ _ _ _
+                (product_rel (labelled_equiv sensitivity_lat Γ l) (@eq unit))
+                _ _ _ _ _ _ _ Hsecc' Heutt2) as Hcomp1.
+  apply pi_eqit_secure_sym in Hcomp1.
+  pose proof (pi_eqit_secure_mixed_trans _ _ _ _ _ _ _ _ _ _ _ _ _ _ Hcomp1 Heutt1) as Hcomp2.
+  apply pi_eqit_secure_sym in Hcomp2.
+  eapply pi_eqit_secure_RR_imp; [ apply state_rel_aux' | apply Hcomp2 ].
 Qed.
 
 
diff --git a/secure_example/LabelledImpHandler.v b/secure_example/LabelledImpHandler.v
index 46320b6a..fe4d67ed 100644
--- a/secure_example/LabelledImpHandler.v
+++ b/secure_example/LabelledImpHandler.v
@@ -90,7 +90,7 @@ Proof.
         setoid_rewrite bind_trigger. apply eqit_secure_public_Vis. cbv. auto.
         intros [].
       * eapply respect_private_e. cbv. auto. constructor. intros [].
-        intros. setoid_rewrite bind_trigger. pfold. constructor. intros [].
+        intros. setoid_rewrite bind_trigger. step. constructor. intros [].
         cbv. auto.
     + destruct (priv_map x) eqn : Hl.
       * apply respect_public'. cbv. rewrite Hl. auto.
diff --git a/secure_example/LabelledImpInline.v b/secure_example/LabelledImpInline.v
index 12fc8432..98641fb3 100644
--- a/secure_example/LabelledImpInline.v
+++ b/secure_example/LabelledImpInline.v
@@ -1,4 +1,4 @@
-From Coq Require Import String.
+From Stdlib Require Import String.
 
 From ITree Require Import
      ITree
diff --git a/secure_example/LabelledImpInline2Asm.v b/secure_example/LabelledImpInline2Asm.v
index 5e13876f..f5e19869 100644
--- a/secure_example/LabelledImpInline2Asm.v
+++ b/secure_example/LabelledImpInline2Asm.v
@@ -1,4 +1,4 @@
-From Coq Require Import Arith Lia List.
+From Stdlib Require Import Arith Lia List.
 
 From ITree Require Import ITree.
 
diff --git a/secure_example/LabelledImpInline2AsmCorrectness.v b/secure_example/LabelledImpInline2AsmCorrectness.v
index 47a00622..979bd807 100644
--- a/secure_example/LabelledImpInline2AsmCorrectness.v
+++ b/secure_example/LabelledImpInline2AsmCorrectness.v
@@ -53,7 +53,7 @@ SAZ: This needs to be updated.
 
 (* begin hide *)
 
-From Coq Require Import
+From Stdlib Require Import
      Arith
      String
      Morphisms
@@ -354,7 +354,7 @@ Section Bisimulation.
   Proof.
     repeat intro. unfold interp_imp_inline, interp_asm.
     repeat rewrite interp_state_bind.
-    eapply eutt_clo_bind.
+    eapply eutt_bind_eutt.
     { eapply H; auto. }
     intros [[regs1 mem1] a] [ [regs2 mem2] a'].
     intros Hs. destruct Hs.
@@ -379,7 +379,7 @@ Section Bisimulation.
     2 : { split; auto. }
     destruct H3. destruct j1 as [ [regs1 mem1] a].
     destruct j2 as [ [regs2 mem2] a']. cbn in *.
-    eapply eutt_clo_bind; eauto. intros [ [regs3 mem3] r1] [ [regs4 mem4 ] r2 ] Hs.
+    eapply eutt_bind_eutt; eauto. intros [ [regs3 mem3] r1] [ [regs4 mem4 ] r2 ] Hs.
     red in Hs. cbn in *. destruct Hs as [Hs Hr].
     inv Hr;
     apply eqit_Ret; constructor; split; auto.
@@ -665,9 +665,9 @@ Section Linking.
     rewrite bind_ret_l.
     destruct (label_case x); cbn.
     - rewrite !bind_bind. setoid_rewrite bind_ret_l. setoid_rewrite bind_bind.
-      eapply eutt_clo_bind; try reflexivity. intros; subst.
+      eapply eutt_bind_eutt; try reflexivity. intros; subst.
       repeat rewrite bind_bind.
-      eapply eutt_clo_bind; try reflexivity. intros; subst.
+      eapply eutt_bind_eutt; try reflexivity. intros; subst.
       unfold from_bif, FromBifunctor_ktree_fin; cbn.
       repeat rewrite bind_bind.
       repeat setoid_rewrite bind_ret_l.
@@ -680,7 +680,7 @@ Section Linking.
       + rewrite (relabel_asm_correct _ _ _ _). cbn.
         rewrite bind_ret_l.
         setoid_rewrite bind_bind.
-        eapply eutt_clo_bind; try reflexivity.
+        eapply eutt_bind_eutt; try reflexivity.
         intros ? ? [].
         repeat rewrite bind_ret_l.
         apply eqit_Ret.
@@ -940,12 +940,12 @@ Section Correctness.
       repeat setoid_rewrite interp_state_bind.
 
       (* The Induction hypothesis on [e1] relates the first itrees *)
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe1; assumption. }
       (* We obtain new related environments *)
       intros [ [l_imp' g_imp'] v] [ [g_asm' l'] [] ]    HSIM.
       (* The Induction hypothesis on [e2] relates the second itrees *)
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe2.
         eapply sim_rel_Renv; eassumption. }
       (* And we once again get new related environments *)
@@ -969,12 +969,12 @@ Section Correctness.
       repeat setoid_rewrite interp_state_bind.
 
       (* The Induction hypothesis on [e1] relates the first itrees *)
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe1; assumption. }
       (* We obtain new related environments *)
       intros [ [l_imp' g_imp'] v] [ [g_asm' l'] [] ]    HSIM.
       (* The Induction hypothesis on [e2] relates the second itrees *)
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe2.
         eapply sim_rel_Renv; eassumption. }
       (* And we once again get new related environments *)
@@ -998,12 +998,12 @@ Section Correctness.
       repeat setoid_rewrite interp_state_bind.
 
       (* The Induction hypothesis on [e1] relates the first itrees *)
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe1; assumption. }
       (* We obtain new related environments *)
       intros [ [l_imp' g_imp'] v] [ [g_asm' l'] [] ]    HSIM.
       (* The Induction hypothesis on [e2] relates the second itrees *)
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe2.
         eapply sim_rel_Renv; eassumption. }
       (* And we once again get new related environments *)
@@ -1040,7 +1040,7 @@ Section Correctness.
     (* By correctness of the compilation of expressions,
        we can match the head trees.
      *)
-    eapply eutt_clo_bind.
+    eapply eutt_bind_eutt.
     { eapply compile_expr_correct; eauto. }
 
     (* Once again, we get related environments *)
@@ -1065,7 +1065,7 @@ Section Correctness.
     red. intros. unfold compile_output. unfold interp_imp_inline, interp_asm.
     rewrite denote_list_app.
     do 2 rewrite interp_state_bind.
-    eapply eutt_clo_bind.
+    eapply eutt_bind_eutt.
     { eapply compile_expr_correct; eauto. }
     intros [ [l_imp' g_imp'] v]  [ [g_asm' l'] y] HSIM.
     simpl in HSIM. cbn.
@@ -1107,7 +1107,7 @@ Section Correctness.
     rewrite unfold_iter_ktree.
     rewrite unfold_iter.
     rewrite !bind_bind.
-    eapply eutt_clo_bind. reflexivity.
+    eapply eutt_bind_eutt. reflexivity.
     intros. subst.
     destruct u2 as [[]|[]].
     2 : { force_right. reflexivity. }
@@ -1116,7 +1116,7 @@ Section Correctness.
     apply eutt_iter' with (RI := fun _ r => inl tt = r).
     - intros _ _ [].
       rewrite <- bind_ret_r at 1.
-      eapply eutt_clo_bind; try reflexivity.
+      eapply eutt_bind_eutt; try reflexivity.
       intros [|[]] _ []; apply eqit_Ret; auto; constructor; auto.
     - constructor.
   Qed.
@@ -1154,19 +1154,19 @@ Section Correctness.
       reflexivity.
     - simpl. rewrite bind_bind. setoid_rewrite bind_bind. rewrite throw_prefix_bind.
       rewrite IHe1. rewrite bind_bind. setoid_rewrite bind_ret_l.
-      eapply eutt_clo_bind; try reflexivity. intros; subst.
+      eapply eutt_bind_eutt; try reflexivity. intros; subst.
       rewrite throw_prefix_bind. rewrite IHe2. rewrite bind_bind.
       setoid_rewrite bind_ret_l. setoid_rewrite throw_prefix_ret.
       reflexivity.
     - simpl. rewrite bind_bind. setoid_rewrite bind_bind. rewrite throw_prefix_bind.
       rewrite IHe1. rewrite bind_bind. setoid_rewrite bind_ret_l.
-      eapply eutt_clo_bind; try reflexivity. intros; subst.
+      eapply eutt_bind_eutt; try reflexivity. intros; subst.
       rewrite throw_prefix_bind. rewrite IHe2. rewrite bind_bind.
       setoid_rewrite bind_ret_l. setoid_rewrite throw_prefix_ret.
       reflexivity.
     -  simpl. rewrite bind_bind. setoid_rewrite bind_bind. rewrite throw_prefix_bind.
       rewrite IHe1. rewrite bind_bind. setoid_rewrite bind_ret_l.
-      eapply eutt_clo_bind; try reflexivity. intros; subst.
+      eapply eutt_bind_eutt; try reflexivity. intros; subst.
       rewrite throw_prefix_bind. rewrite IHe2. rewrite bind_bind.
       setoid_rewrite bind_ret_l. setoid_rewrite throw_prefix_ret.
       reflexivity.
@@ -1275,9 +1275,9 @@ Section Correctness.
   Proof.
     intros. rewrite <- bind_ret_r. apply eqit_flip in H. eapply eqit_bind'; eauto.
     intros. red in H0. destruct r2 as [ ? | [ | ] ]; cbn.
-    - setoid_rewrite (unique_fin _ r1 f0); auto. reflexivity.
-    - setoid_rewrite (unique_fin _ r1 (fS f0)); auto. reflexivity.
-    - setoid_rewrite (unique_fin _ r1 (fS (fS f0))); auto. reflexivity.
+    - setoid_rewrite (unique_fin _ r1 f0); auto; try reflexivity.
+    - setoid_rewrite (unique_fin _ r1 (fS f0)); auto; try reflexivity.
+    - setoid_rewrite (unique_fin _ r1 (fS (fS f0))); auto; try reflexivity.
   Qed.
 
   Lemma exception_to_sum_correct_eutt_eq (p : asm 1 1) :
@@ -1347,7 +1347,7 @@ Section Correctness.
       cbn. rewrite throw_prefix_bind. rewrite <- fold_to_itree'.
       rewrite throw_prefix_denote_expr. rewrite bind_bind. setoid_rewrite bind_ret_l.
       red. intros. unfold interp_imp_inline, interp_asm. do 2 rewrite interp_state_bind.
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply compile_expr_correct; eauto. }
       intros. destruct u1 as [ [reg0 mem0] v]. destruct u2 as [ [reg mem] ?  ]. destruct u.
       cbn. assert (Htmp : reg 0 = v).
@@ -1376,7 +1376,7 @@ Section Correctness.
         repeat rewrite bind_bind. setoid_rewrite bind_bind. setoid_rewrite bind_ret_l.
         red. intros.
         unfold interp_imp_inline, interp_asm.
-        do 2 rewrite interp_state_bind. eapply eutt_clo_bind.
+        do 2 rewrite interp_state_bind. eapply eutt_bind_eutt.
         {  eapply compile_expr_correct; auto. }
         intros [ [reg0 mem0] v] [ [reg mem] [] ]. cbn.
         intros [HRenv [ Hreg0  ? ] ].
@@ -1390,7 +1390,7 @@ Section Correctness.
         * repeat setoid_rewrite bind_bind. setoid_rewrite throw_prefix_bind.
           setoid_rewrite bind_bind. rewrite bind_trigger. rewrite interp_state_vis.
           cbn. setoid_rewrite bind_ret_l. rewrite tau_eutt. cbn. unfold get_reg, tmp_if. rewrite Hreg0.
-          setoid_rewrite bind_bind. do 2 rewrite interp_state_bind. eapply eutt_clo_bind.
+          setoid_rewrite bind_bind. do 2 rewrite interp_state_bind. eapply eutt_bind_eutt.
           { apply IHs; auto. }
           intros [ [reg'0 mem'0 ] [ [] | [ | ] ] ] [ [reg' mem' ] l' ] Hst.
           -- cbn. setoid_rewrite bind_ret_l. setoid_rewrite throw_prefix_ret.
diff --git a/secure_example/LabelledImpInline2AsmNoninterferencePres.v b/secure_example/LabelledImpInline2AsmNoninterferencePres.v
index 3de96ac6..896eb294 100644
--- a/secure_example/LabelledImpInline2AsmNoninterferencePres.v
+++ b/secure_example/LabelledImpInline2AsmNoninterferencePres.v
@@ -1,4 +1,4 @@
-From Coq Require Import Morphisms Program.Basics.
+From Stdlib Require Import Morphisms Program.Basics.
 
 From ITree Require Import
      ITree
@@ -78,7 +78,7 @@ Proof.
   specialize (eutt_secure_eqit_secure) as Htrans.
   eapply Htrans in Heutt; eauto.
   eapply SecureEqEuttHalt.eqit_secure_RR_imp; try apply Heutt.
-  intros. inv PR. inv REL1. destruct x0. destruct r2. clear Hsecs' Htrans Heutt. cbn in *.
+  intros x0 x1 PR. inv PR. inv REL1. destruct x0. destruct r2. clear Hsecs' Htrans Heutt. cbn in *.
   destruct x1. constructor; auto. constructor; auto. cbn. destruct REL2. cbn in *.
   destruct H1. cbn in *. etransitivity; eauto.
 Qed.
@@ -103,19 +103,14 @@ Proof.
          ).
   {
     eapply SecureEqEuttHalt.eqit_secure_RR_imp with (RR1 := rcompose _ _ ).
-    2 : eapply Htrans; eauto. 2 : eapply Hcomp. 2 : reflexivity.
-    intros. inv PR. inv REL1. inv REL2. inv H1. inv H3. constructor; auto.
+    2 : eapply Htrans; eauto.
+    intros x0 x1 PR. inv PR. inv REL1. inv REL2. inv H1. inv H3. constructor; auto.
     constructor; auto. etransitivity; eauto.
   }
-  eapply Htrans in Hsec''; eauto.
-  2 : {
-    apply eqit_secure_sym. eapply Hcomp. reflexivity.
-  }
-  Unshelve. 2 : apply regs1.
-  eapply SecureEqEuttHalt.eqit_secure_RR_imp; try apply Hsec''.
-  intros. inv PR. inv REL1. inv REL2. inv H1. inv H3. constructor; auto.
-  constructor; auto. etransitivity; eauto. etransitivity; eauto. symmetry. eauto.
-  reflexivity.
+  eapply SecureEqEuttHalt.eqit_secure_RR_imp.
+  2 : { eapply Htrans. apply eqit_secure_sym. eapply Hcomp. reflexivity. apply Hsec''. }
+  intros x0 x1 PR. inv PR. inv REL1. inv REL2. inv H1. inv H3. constructor; auto.
+  constructor; auto. etransitivity. symmetry. eassumption. assumption. 
 Qed.
 
 
@@ -171,8 +166,7 @@ Proof.
   eapply Htrans in Heutt1; eauto. apply pi_eqit_secure_sym.
   eapply pi_eqit_secure_RR_imp; eauto. unfold flip.
   intros. inv H3. inv REL1. inv REL2. inv H3. constructor; auto.
-  constructor; auto. etransitivity; eauto. etransitivity; eauto. symmetry. eauto.
-  reflexivity.
+  constructor; auto. etransitivity. symmetry. eassumption. assumption. 
 Qed.
 
 
diff --git a/secure_example/LabelledImpInlineTypes.v b/secure_example/LabelledImpInlineTypes.v
index 14669385..f5446aad 100644
--- a/secure_example/LabelledImpInlineTypes.v
+++ b/secure_example/LabelledImpInlineTypes.v
@@ -1,4 +1,4 @@
-From Coq Require Import Morphisms String.
+From Stdlib Require Import Morphisms String.
 
 From ITree Require Import
      ITree
@@ -140,7 +140,7 @@ Proof.
     eapply secure_eqit_bind; try apply IHe1; eauto. intros [? ?] [? ?] [? ?]. inv H1. cbn in *. destruct p; destruct p0. cbn in *.
     eapply secure_eqit_bind; try apply IHe2; eauto. intros. cbn in *.
     setoid_rewrite interp_state_ret. apply secure_eqit_ret; split; auto.
-    split; auto. cbn. inv H1. inv H5. etransitivity; eauto. reflexivity.
+    split; auto. cbn. inv H1. inv H5. etransitivity; eauto. 
   - repeat setoid_rewrite interp_state_bind.
     match goal with |- eqit_secure _ _ _ _ _ _ _ ?t =>
     assert ( t ≈ ITree.bind (Ret (regs2, σ2, n)) (fun st => ITree.bind (Ret (fst st, n) ) (fun st => Ret (fst st,n))  )  ) end.
@@ -149,7 +149,7 @@ Proof.
     eapply secure_eqit_bind; try apply IHe1; eauto. intros [? ?] [? ?] [? ?]. inv H1. cbn in *. destruct p; destruct p0. cbn in *.
     eapply secure_eqit_bind; try apply IHe2; eauto. intros. cbn in *.
     setoid_rewrite interp_state_ret. apply secure_eqit_ret; split; auto.
-    split; auto. cbn. inv H1. inv H5. etransitivity; eauto. reflexivity.
+    split; auto. cbn. inv H1. inv H5. etransitivity; eauto. 
   - repeat setoid_rewrite interp_state_bind.
     match goal with |- eqit_secure _ _ _ _ _ _ _ ?t =>
     assert ( t ≈ ITree.bind (Ret (regs2, σ2, n)) (fun st => ITree.bind (Ret (fst st, n) ) (fun st => Ret (fst st,n))  )  ) end.
@@ -158,7 +158,7 @@ Proof.
     eapply secure_eqit_bind; try apply IHe1; eauto. intros [? ?] [? ?] [? ?]. inv H1. cbn in *. destruct p; destruct p0. cbn in *.
     eapply secure_eqit_bind; try apply IHe2; eauto. intros. cbn in *.
     setoid_rewrite interp_state_ret. apply secure_eqit_ret; split; auto.
-    split; auto. cbn. inv H1. inv H5. etransitivity; eauto. reflexivity.
+    split; auto. cbn. inv H1. inv H5. etransitivity; eauto.
 Qed.
 
 Lemma expr_only_ret e observer:  exists n : value, label_state_sec_eutt Γ observer top2 (sem_expr e) (ret n) .
@@ -210,7 +210,7 @@ Proof.
   }
   eapply eqit_secure_trans; eauto. eapply eqit_secure_sym.
   apply eqit_secure_RR_imp with (RR1 := Rst).
-  { intros. split.
+  { intros ? ? PR. split.
     split; [cbv; auto | unfold Rst in *].
     inv PR. inv H. symmetry. auto. inv PR. symmetry. auto.
   }
@@ -224,7 +224,7 @@ Proof.
     - inv H0. inv H2. cbn in *. etransitivity; eauto.
     - inv H0. inv H2. cbn in *. etransitivity; eauto.
   }
-  eapply eqit_secure_trans; try apply Hr2; eauto. reflexivity.
+  eapply eqit_secure_trans; try apply Hr2; eauto.
 Qed.
 
 Lemma state_secure_eutt_throw_ret_aux:
@@ -264,8 +264,12 @@ Proof.
   eapply eqit_secure_RR_imp with (RR1 := rcompose Rst (rcompose eq (fun x1 x2 => Rst x2 x1)) ).
   { unfold Rst.
     intros [ [? ?] [ [] | ?] ] [ [? ?] [ [] | ?] ]; intro Hrcomp; unfold Rst'.
-    - split. split; auto. cbv. auto. cbn. inv Hrcomp. inv REL1. inv H. inv REL2. inv REL0. etransitivity; eauto.
-      cbn in *. inv H. symmetry. auto. split; constructor.
+    - destruct Hrcomp as [rmid HL HR]. destruct HR as [rmid' Heqmid HR].
+      subst rmid'. destruct rmid as [ [? ?] ?].
+      destruct HL as [ [_ HeqL] _ ]. destruct HR as [ [_ HeqR] _ ].
+      cbn in *.
+      split; [ split; [ cbv; auto | ] | split; constructor ].
+      cbn. etransitivity; eauto. symmetry. auto.
     - inv Hrcomp. inv REL2. inv REL3. inv H0.
     - inv Hrcomp. inv REL2. inv REL3. inv REL1. inv H1. inv H2.
     - inv Hrcomp. inv REL2. inv REL3. inv REL1. inv H1. inv H2.
@@ -291,7 +295,7 @@ Lemma state_secure_eutt_ret_aux:
                   true observer (interp_imp_inline t1 (regs1, σ1))
                   (interp_imp_inline t2 (regs2, σ2))).
 Proof.
-  intros. eapply state_secure_eutt_equiv_ret_aux; eauto. 2 : cbv; auto.
+  intros. eapply state_secure_eutt_equiv_ret_aux; eauto.
   constructor; constructor.
 Qed.
 Notation update := LabelledImp.update.
@@ -434,7 +438,7 @@ Proof.
       reflexivity.
       setoid_rewrite interp_state_bind. setoid_rewrite throw_prefix_denote_expr.
       setoid_rewrite interp_state_bind.
-      eapply secure_eqit_bind; eauto. intros [ [regs3 σ3] v1] [ [regs4 σ4] v2] [ [ _ Hσ] Hr]. cbn in Hr; subst. setoid_rewrite interp_state_ret. apply secure_eqit_ret. split; auto. split; auto. red. auto. cbn. split; auto. constructor.
+      eapply secure_eqit_bind; eauto. intros [ [regs3 σ3] v1] [ [regs4 σ4] v2] [ [ _ Hσ] Hr]. cbn in Hr; subst. setoid_rewrite interp_state_ret. apply secure_eqit_ret. repeat split; cbn; auto.
   - case_leq pc observer.
     + left; auto.
       destruct H0 as [n Hn]. unfold sem_throw_stmt.
@@ -467,7 +471,7 @@ Proof.
       setoid_rewrite throw_prefix_ev. setoid_rewrite interp_state_vis. cbn. rewrite bind_ret_l.
       rewrite interp_state_tau. eapply proper_eutt_secure_eutt; repeat rewrite tau_eutt; try reflexivity.
       setoid_rewrite throw_prefix_ret. setoid_rewrite interp_state_ret. cbn. apply secure_eqit_ret.
-      split; try constructor; auto. cbn. constructor. cbn. apply update_labelled_equiv_invisible; auto.
+      split; try constructor; auto. cbn. apply update_labelled_equiv_invisible; auto.
 Qed.
 
 
@@ -501,7 +505,7 @@ Proof.
     cbn in H2, H3. subst. cbn. eapply proper_eutt_secure_eutt; try apply interp_state_trigger.
     cbn. setoid_rewrite bind_trigger. cbn.
     apply eqit_secure_public_Vis; try apply H.
-    intros []. apply secure_eqit_ret; auto. split; auto. split; auto. cbv; auto.
+    intros []. apply secure_eqit_ret; auto. split; auto. split; auto.
   - case_leq pc observer.
     + left; auto. destruct H0 as [n Hn]. do 2 red in Hn. cbn in Hn.
       unfold sem_stmt. cbn. unfold interp_imp_inline, interp_asm. do 2 red.
@@ -639,7 +643,6 @@ Proof.
     intros [ [ ? σ3] [ [] | ?] ] [ [ ? σ4] [ [] | ? ]] [ [ _ Hσ] Hr] ; inv Hr.
     + cbn. inv Hc2obs; try contradiction. eapply H3; eauto.
     + destruct H4; subst; cbn. setoid_rewrite interp_state_ret. apply secure_eqit_ret. split; try constructor; auto.
-      constructor.
   - right; auto. unfold sem_throw_stmt, interp_imp_inline, interp_asm. cbn. do 2 red. intros.
     setoid_rewrite throw_prefix_bind. setoid_rewrite interp_state_bind.
     inv Hc2obs; try contradiction.
diff --git a/secure_example/LabelledImpInlineTypesProgInsens.v b/secure_example/LabelledImpInlineTypesProgInsens.v
index a1ab5a6a..60401816 100644
--- a/secure_example/LabelledImpInlineTypesProgInsens.v
+++ b/secure_example/LabelledImpInlineTypesProgInsens.v
@@ -1,4 +1,4 @@
-From Coq Require Import Morphisms.
+From Stdlib Require Import Morphisms.
 
 From ITree Require Import
      ITree
@@ -66,7 +66,7 @@ Definition state_equiv {E R} (m1 m2 : stateT map (itree E) R) := forall (σ : ma
 Global Instance proper_eutt_pi_secure_eutt  {E R1 R2 RR Label priv l} : Proper (@eutt E R1 R1 eq ==> @eutt E R2 R2 eq ==> Basics.flip Basics.impl)
                                                                (pi_eqit_secure Label priv RR true true l).
 Proof.
-  eapply pi_eqit_secure_eq_itree_proper. all : apply true.
+  eapply pi_eqit_secure_eutt_proper. all : apply true.
 Qed.
 
 Global Instance proper_eq_itree_secure_eutt  {E R1 R2 RR Label priv l} : Proper (@eq_itree E R1 R1 eq ==> @eq_itree E R2 R2 eq ==> Basics.flip Basics.impl)
@@ -241,14 +241,14 @@ Proof.
   specialize (Hs1 observer). inv Hs1.
   - left; auto. unfold sem_stmt, interp_imp.
     cbn. do 2 red. intros σ1 σ2 regs1 regs2 Hσ. setoid_rewrite interp_state_bind.
-    eapply pi_eqit_secure_bind; eauto. intros [ [ ? σ3] [] ] [ [ ? σ4] [] ] [ [ _ Hσ'] _ ].
+    eapply pi_secure_eqit_bind'; eauto. intros [ [ ? σ3] [] ] [ [ ? σ4] [] ] [ [ _ Hσ'] _ ].
     specialize (Hs2 observer). inv Hs2; eauto. cbn. do 2 red in H2. cbn in H2.
     eapply pi_sem_stmt_ret_aux; eauto.
   - right; auto. cbn in H0. unfold sem_stmt, interp_imp. cbn.
     do 2 red. intros σ1 σ2 regs1 regs2 Hσ.
     setoid_rewrite <- bind_ret_r with (s := Ret (regs2, σ2, tt) ).
     setoid_rewrite interp_state_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [ [ ? σ3] [] ] [ [ ? σ4] [] ] [ [ _ Hσ'] _ ].
     specialize (Hs2 observer). inv Hs2; eauto.
     + exfalso. apply H. eapply leq_trans_lat; eauto; apply sensitivity_latlaws.
@@ -265,7 +265,7 @@ Proof.
   - left; auto. unfold sem_throw_stmt, interp_imp_inline, interp_asm. cbn. do 2 red.
     intros σ1 σ2 regs1 regs2 Hσ. setoid_rewrite throw_prefix_bind.
     setoid_rewrite interp_state_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [ [ ? σ3] r1] [ [ ? σ4] r2] [ [ _ Hσ'] Hr]. inv Hr.
     + specialize (Hs2 observer). cbn in *. subst. inv Hs2; eauto.
       * cbn in *.
@@ -290,7 +290,7 @@ Proof.
       |- pi_eqit_secure _ _ _ _ _ _ _ ?t => assert (t ≈ ITree.bind (Ret (r0, σ4,tt) ) (fun '(σ',x) => Ret (σ', inr lpriv) )) end.
         rewrite bind_ret_l. reflexivity.
         rewrite H3. rewrite <- bind_ret_r.
-        eapply pi_eqit_secure_bind; eauto.
+        eapply pi_secure_eqit_bind'; eauto.
         intros [ [ ? σ5] r3] [ [ ? σ6] r4] [ [ _ Hσ''] Hr']; inv Hr'.
         -- cbn in H4. subst. apply pi_eqit_secure_ret. repeat (split; auto).
            constructor; auto. eapply leq_trans_lat; eauto; try apply leq_join_l; auto; apply sensitivity_latlaws.
@@ -307,7 +307,7 @@ Proof.
         |- pi_eqit_secure _ _ _ _ _ _ ?t _ => assert (t ≈ ITree.bind (Ret (r, σ3,tt) ) (fun '(σ',x) => Ret (σ', inr lpriv) )) end.
         rewrite bind_ret_l. reflexivity. rewrite H3.
         setoid_rewrite <- bind_ret_r at 4.
-        apply pi_eqit_secure_sym. symmetry in Hσ'. eapply pi_eqit_secure_bind; eauto.
+        apply pi_eqit_secure_sym. symmetry in Hσ'. eapply pi_secure_eqit_bind'; eauto.
         intros [ [ ? σ5] r3] [ [ ? σ6] [] ] [ [ _ Hσ''] Hr']; inv Hr'.
         -- cbn in H4. subst. apply pi_eqit_secure_ret. repeat (split; auto). symmetry. auto.
            cbn.
@@ -319,7 +319,7 @@ Proof.
   - right; auto. intros σ1 σ2 regs1 regs2 Hσ. unfold sem_throw_stmt, interp_imp_inline, interp_asm.
     cbn. setoid_rewrite throw_prefix_bind. setoid_rewrite interp_state_bind.
     cbn in H0. rewrite <- bind_ret_r with (s := Ret (regs2, σ2, tt) ).
-    eapply pi_eqit_secure_bind; eauto. intros [ [ ? σ3] r1] [ [ ? σ4] [] ] [ [ _ Hσ'] Hr]. inv Hr.
+    eapply pi_secure_eqit_bind'; eauto. intros [ [ ? σ3] r1] [ [ ? σ4] [] ] [ [ _ Hσ'] Hr]. inv Hr.
     -- cbn in H1. subst. cbn. specialize (Hs2 observer). inv Hs2.
        ++ do 2 red in H2. exfalso. apply H. eapply leq_trans_lat; eauto; try apply leq_join_l; auto; apply sensitivity_latlaws.
        ++ do 2 red in H2. cbn in H2. eapply lower_lexn_sound'; eauto; try apply leq_join_r; auto; apply sensitivity_latlaws.
@@ -340,7 +340,7 @@ Proof.
   inv Hs1; inv Hs1t; try contradiction.
   - left; auto. unfold sem_stmt, interp_imp_inline, interp_asm. do 2 red. intros σ1 σ2 regs1 regs2 Hσ.
     cbn. setoid_rewrite try_catch_to_throw_prefix.
-    setoid_rewrite interp_state_bind. eapply pi_eqit_secure_bind; eauto.
+    setoid_rewrite interp_state_bind. eapply pi_secure_eqit_bind'; eauto.
     intros [ [ ? σ3] r1 ] [ [ ? σ4] r2 ] [ [ _ Hσ'] Hr] ; inv Hr; cbn.
     + cbn in H3, H4. subst. setoid_rewrite interp_state_ret. apply pi_eqit_secure_ret. repeat (split; auto).
     + cbn in H5, H6. subst. specialize (Hs2 observer). inv Hs2; eauto. do 2 red in H6.
@@ -357,7 +357,7 @@ Proof.
         eapply leq_trans_lat; auto. apply leq_join_r; auto. eauto.
       * do 2 red in H8.
         apply pi_eqit_secure_RR_imp with (RR1 := product_rel (product_rel top2 (labelled_equiv Γ observer)) top2).
-        { intros [ [ ? ?] [] ] [ [ ? ?] [] ] [ [? ?] ? ] . inv H9. repeat (split; auto). }
+        { intros [ [ ? ?] [] ] [ [ ? ?] [] ] [ [? ?] ? ] . repeat (split; auto). }
         cbn in H8. cbn in H5, H6. subst. setoid_rewrite interp_state_ret. eapply H8. auto.
   - right; auto. unfold sem_stmt, interp_imp_inline, interp_asm. do 2 red. intros σ1 σ2 regs1 regs2 Hσ.
     cbn. setoid_rewrite try_catch_to_throw_prefix.
@@ -366,7 +366,7 @@ Proof.
       |- pi_eqit_secure _ _ _ _ _ _ _ ?t => assert (t ≈ ITree.bind (Ret (regs2, σ2,tt) ) (fun x => Ret x)) end.
     rewrite bind_ret_r. reflexivity. rewrite H3.
     setoid_rewrite interp_state_bind. cbn in H2.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [ [ ? σ3] r1] [ [ ? σ4] [] ] [ [ _ Hσ'] Hr]; inv Hr.
     + cbn in H4. subst. tau_steps. apply pi_eqit_secure_ret. repeat (split; auto).
     + specialize (Hs2 observer). inv Hs2; eauto.
@@ -386,7 +386,7 @@ Proof.
     setoid_rewrite try_catch_to_throw_prefix.
     setoid_rewrite throw_prefix_bind.
     repeat setoid_rewrite interp_state_bind. setoid_rewrite bind_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [ [ ? σ3] r1] [ [ ? σ4] r2] [ [ _ Hσ'] Hr]; inv Hr; cbn;
       try setoid_rewrite throw_prefix_ret; try setoid_rewrite interp_state_ret;
         try setoid_rewrite bind_ret_l; cbn.
@@ -405,7 +405,7 @@ Proof.
         match goal with
         |- pi_eqit_secure _ _ _ _ _ _ _ ?t => assert (t ≈ ITree.bind (Ret (r, σ3, tt) ) (fun '(σ, x) => Ret (σ, inl x) ) ) end.
         rewrite bind_ret_l. reflexivity. rewrite H5.
-        rewrite <- bind_ret_r. symmetry in Hσ'. eapply pi_eqit_secure_bind; eauto.
+        rewrite <- bind_ret_r. symmetry in Hσ'. eapply pi_secure_eqit_bind'; eauto.
         intros [ [ ? σ5] r'] [ [ ? σ6] [] ] Hr. inv Hr. inv H9.
         -- apply pi_eqit_secure_ret. repeat (split; auto). symmetry. inv H6. auto. cbn in H10. subst.
            constructor.
@@ -420,7 +420,7 @@ Proof.
          match goal with
         |- pi_eqit_secure _ _ _ _ _ _ _ ?t => assert (t ≈ ITree.bind (Ret (r0, σ4, tt) ) (fun '(σ, x) => Ret (σ, inl x) ) ) end.
         rewrite bind_ret_l. reflexivity. rewrite H5. cbn in H8.
-        rewrite <- bind_ret_r. eapply pi_eqit_secure_bind; eauto.
+        rewrite <- bind_ret_r. eapply pi_secure_eqit_bind'; eauto.
         intros [ [ ? σ5] r'] [ [ ? σ6] [] ] Hr. inv Hr. inv H9.
         -- cbn in H10. subst. apply pi_eqit_secure_ret. repeat (split; auto). constructor.
         -- cbn in H12. subst. apply pi_eqit_secure_ret. repeat (split; auto).
@@ -432,7 +432,7 @@ Proof.
     rewrite bind_bind.
     setoid_rewrite <- bind_ret_r with (s := Ret (regs2, σ2, tt) ).
     cbn in H2.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [ [ ? σ3] r1] [ [ ? σ4] r2] [ [ _ Hσ'] Hr]; inv Hr.
     + cbn in H3. subst. cbn. rewrite throw_prefix_ret, interp_state_ret, bind_ret_l. cbn.
       rewrite interp_state_ret. apply pi_eqit_secure_ret. repeat (split; auto).
@@ -466,7 +466,7 @@ Proof.
   + cbn. rewrite interp_state_bind. rewrite bind_bind.
     rewrite <- (bind_ret_r (Ret (regs2, σ2, tt))).
     cbn in H0.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [ [ ? σ4] [] ] [ [ ? σ5] [] ] [ [ _ Hσ'] _ ]. rewrite interp_state_ret, bind_ret_l. cbn.
     apply pi_eqit_secure_ret. constructor. repeat (split; auto).
 Qed.
@@ -502,7 +502,7 @@ Proof.
   + rewrite throw_prefix_bind. rewrite interp_state_bind. rewrite bind_bind.
     rewrite <- (bind_ret_r (Ret (regs2, σ2, tt))).
     cbn in H0.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [ [ ? σ4] r1] [ [ ? σ5] r2'] [ [ _ Hσ'] Hr]; inv Hr.
      * cbn in H. subst. tau_steps. apply pi_eqit_secure_ret.
       constructor; auto. repeat (split; auto). destruct r2'. auto.
@@ -519,21 +519,20 @@ Proof.
   - left. eapply leq_trans_lat; try apply H; auto. apply leq_join_l; auto.
     do 2 red. intros σ1 σ2 regs1 regs2 Hσ. unfold sem_stmt, interp_imp_inline, interp_asm. cbn.
     specialize (@interp_state_iter') as Hisi. red in Hisi. setoid_rewrite Hisi.
-    apply secure_eqit_iter with (RA := product_rel (product_rel top2 (labelled_equiv Γ observer)) eq );
-      auto.
-    clear σ1 σ2 Hσ. intros [ [ ? σ1] [] ] [ [ ? σ2] [] ] [ [ _ Hσ] _ ].
-    cbn. setoid_rewrite interp_state_bind. repeat rewrite bind_bind.
-    eapply pi_eqit_secure_bind; eauto.
-    intros [ [ ? σ3] v1] [ [ ? σ4] v2] [ [ _ Hσ'] Hv]; cbn in Hv; subst. cbn.
-    destruct v2.
-    + setoid_rewrite interp_state_ret. setoid_rewrite bind_ret_l.
-      cbn. apply pi_eqit_secure_ret. constructor. repeat (split; auto).
-    + setoid_rewrite interp_state_bind. setoid_rewrite bind_bind.
-      eapply pi_eqit_secure_bind; eauto.
-      intros [ [ ? σ5] [] ] [ [ ? σ6] [] ] [ [ _ Hσ''] _ ]. setoid_rewrite interp_state_ret.
-      setoid_rewrite bind_ret_l. cbn. apply pi_eqit_secure_ret.
-      constructor; repeat (split; auto).
+    apply secure_eqit_iter with (RA := product_rel (product_rel top2 (labelled_equiv Γ observer)) eq ).
     + repeat (split; auto).
+    + clear σ1 σ2 Hσ. intros [ [ ? σ1] [] ] [ [ ? σ2] [] ] [ [ _ Hσ] _ ].
+      cbn. setoid_rewrite interp_state_bind. repeat rewrite bind_bind.
+      eapply pi_secure_eqit_bind'; eauto.
+      intros [ [ ? σ3] v1] [ [ ? σ4] v2] [ [ _ Hσ'] Hv]; cbn in Hv; subst. cbn.
+      destruct v2.
+      ++ setoid_rewrite interp_state_ret. setoid_rewrite bind_ret_l.
+         cbn. apply pi_eqit_secure_ret. constructor. repeat (split; auto).
+      ++ setoid_rewrite interp_state_bind. setoid_rewrite bind_bind.
+         eapply pi_secure_eqit_bind'; eauto.
+         intros [ [ ? σ5] [] ] [ [ ? σ6] [] ] [ [ _ Hσ''] _ ]. setoid_rewrite interp_state_ret.
+         setoid_rewrite bind_ret_l. cbn. apply pi_eqit_secure_ret.
+         constructor; repeat (split; auto).
   - exfalso. apply H1.
     eapply leq_trans_lat with (l2 := join_sense le lexn); eauto.
     apply leq_join_l; auto.
@@ -562,35 +561,35 @@ Proof.
     do 2 red. intros σ1 σ2 regs1 regs2 Hσ. unfold sem_throw_stmt, interp_imp_inline, interp_asm. cbn.
     setoid_rewrite throw_prefix_iter.
     specialize (@interp_state_iter') as Hisi. red in Hisi. setoid_rewrite Hisi.
-    eapply secure_eqit_iter with (RA := product_rel (product_rel top2 (labelled_equiv Γ observer)) eq ); auto.
-    intros [ [ ? σ3] [] ] [ [ ? σ4] [] ] [ [ _ Hσ'] _ ]. cbn. setoid_rewrite throw_prefix_bind.
-    repeat setoid_rewrite interp_state_bind. repeat rewrite bind_bind.
-    setoid_rewrite throw_prefix_denote_expr. setoid_rewrite interp_state_bind.
-    setoid_rewrite bind_bind.
-    eapply pi_eqit_secure_bind; eauto. intros [ [ ? σ5] v1] [ [ ? σ6] v2] [ [ _ Hσ''] Hv]; cbn in Hv; subst.
-    setoid_rewrite interp_state_ret. setoid_rewrite bind_ret_l. cbn.
-    destruct v2; cbn.
-    + setoid_rewrite throw_prefix_ret. tau_steps.
-      apply pi_eqit_secure_ret. constructor. repeat (split; auto). constructor.
-    + setoid_rewrite throw_prefix_bind. setoid_rewrite interp_state_bind.
-      setoid_rewrite bind_bind.
-      eapply pi_eqit_secure_bind; eauto.
-      intros [ [ ? σ7] r1'] [ [ ? σ8] r2'] [ [ _ Hσ'''] Hr]. cbn in Hr. inv Hr.
-      * setoid_rewrite throw_prefix_ret. tau_steps.
-        apply pi_eqit_secure_ret. constructor. repeat (split; auto).
-      * tau_steps. apply pi_eqit_secure_ret. constructor. repeat (split; auto).
-        constructor; auto.
-      * exfalso. apply H4.
-        eapply leq_trans_lat; eauto.
-        eapply leq_trans_lat; try apply H; auto.
-        eapply leq_trans_lat with (l2 := join_sense le lexn); eauto.
-        apply leq_join_r; auto. apply leq_join_r; auto.
-      * exfalso.  apply H4.
-        eapply leq_trans_lat; eauto.
-        eapply leq_trans_lat; try apply H; auto.
-        eapply leq_trans_lat with (l2 := join_sense le lexn); eauto.
-        apply leq_join_r; auto. apply leq_join_r; auto.
+    eapply secure_eqit_iter with (RA := product_rel (product_rel top2 (labelled_equiv Γ observer)) eq ).
     + repeat (split; auto).
+    + intros [ [ ? σ3] [] ] [ [ ? σ4] [] ] [ [ _ Hσ'] _ ]. cbn. setoid_rewrite throw_prefix_bind.
+      repeat setoid_rewrite interp_state_bind. repeat rewrite bind_bind.
+      setoid_rewrite throw_prefix_denote_expr. setoid_rewrite interp_state_bind.
+      setoid_rewrite bind_bind.
+      eapply pi_secure_eqit_bind'; eauto. intros [ [ ? σ5] v1] [ [ ? σ6] v2] [ [ _ Hσ''] Hv]; cbn in Hv; subst.
+      setoid_rewrite interp_state_ret. setoid_rewrite bind_ret_l. cbn.
+      destruct v2; cbn.
+      ++ setoid_rewrite throw_prefix_ret. tau_steps.
+         apply pi_eqit_secure_ret. constructor. repeat (split; auto). constructor.
+      ++ setoid_rewrite throw_prefix_bind. setoid_rewrite interp_state_bind.
+         setoid_rewrite bind_bind.
+         eapply pi_secure_eqit_bind'; eauto.
+         intros [ [ ? σ7] r1'] [ [ ? σ8] r2'] [ [ _ Hσ'''] Hr]. cbn in Hr. inv Hr.
+         ** setoid_rewrite throw_prefix_ret. tau_steps.
+            apply pi_eqit_secure_ret. constructor. repeat (split; auto).
+         ** tau_steps. apply pi_eqit_secure_ret. constructor. repeat (split; auto).
+            constructor; auto.
+         ** exfalso. apply H4.
+            eapply leq_trans_lat; eauto.
+            eapply leq_trans_lat; try apply H; auto.
+            eapply leq_trans_lat with (l2 := join_sense le lexn); eauto.
+            apply leq_join_r; auto. apply leq_join_r; auto.
+         ** exfalso.  apply H4.
+            eapply leq_trans_lat; eauto.
+            eapply leq_trans_lat; try apply H; auto.
+            eapply leq_trans_lat with (l2 := join_sense le lexn); eauto.
+            apply leq_join_r; auto. apply leq_join_r; auto.
   - exfalso. apply H1. eapply leq_trans_lat; eauto.
     eapply leq_trans_lat with (l2 := join_sense le lexn); auto.
     apply leq_join_l; auto. apply leq_join_r; auto.
@@ -621,7 +620,7 @@ Proof.
     apply leq_join_l; auto.
     intros σ1 σ2 regs1 regs2 Hσ. unfold sem_stmt, interp_imp_inline, interp_asm.
     cbn. setoid_rewrite interp_state_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [ [ ? σ3] v1] [ [ ? σ4] v2] [ [ _ Hσ'] Hv]; cbn in Hv; subst.
     destruct v2; cbn; eauto.
   - exfalso. apply H3. eapply leq_trans_lat; eauto.
@@ -662,7 +661,7 @@ Proof.
     rewrite throw_prefix_denote_expr.
     repeat setoid_rewrite interp_state_bind.
     repeat setoid_rewrite bind_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [ [ ? σ3] v1] [ [ ? σ4] v2] [ [ _ Hσ'] Hv]; cbn in Hv; subst.
     setoid_rewrite interp_state_ret. setoid_rewrite bind_ret_l.
     cbn. destruct v2; eauto.
@@ -741,7 +740,7 @@ Proof.
   - left. eapply leq_trans_lat; eauto.
     do 2 red in H0. do 2 red. intros. unfold sem_stmt.
     cbn. unfold interp_imp_inline, interp_asm.
-    setoid_rewrite interp_state_bind. eapply pi_eqit_secure_bind; eauto.
+    setoid_rewrite interp_state_bind. eapply pi_secure_eqit_bind'; eauto.
     intros [ [ ? σ3] v1] [ [ ? σ4] v2] [ [ _ Hσ] Hv]; cbn in Hv; subst.
     setoid_rewrite interp_state_trigger. cbn. apply pi_eqit_secure_ret.
     repeat (split; auto). cbn. eapply update_labelled_equiv_visible; auto.
@@ -783,7 +782,7 @@ Proof.
     setoid_rewrite throw_prefix_denote_expr.
     setoid_rewrite interp_state_bind.
     setoid_rewrite interp_state_bind. repeat rewrite bind_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [ [ ? σ3] v1] [ [ ? σ4] v2] [ [ _ Hσ] Hv]; cbn in Hv; subst.
     setoid_rewrite interp_state_ret. setoid_rewrite bind_ret_l. cbn.
     setoid_rewrite throw_prefix_ev.
@@ -833,7 +832,7 @@ Proof.
   - left. eapply leq_trans_lat; eauto.
     unfold sem_stmt, interp_imp_inline, interp_asm. intros σ1 σ2 regs1 regs2 Hσ.
     cbn. setoid_rewrite interp_state_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [ [ ? σ3] v1] [ [ ? σ4] v4] [ [ _ Hσ'] Hv]; cbn in Hv; subst.
     cbn. setoid_rewrite interp_state_trigger. cbn.
     setoid_rewrite bind_trigger. apply pi_eqit_secure_pub_vis.
@@ -872,7 +871,7 @@ Proof.
     cbn. setoid_rewrite throw_prefix_bind. setoid_rewrite interp_state_bind.
     setoid_rewrite throw_prefix_denote_expr. setoid_rewrite interp_state_bind.
     repeat rewrite bind_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [ [ ? σ3] v1] [ [ ? σ4] v4] [ [ _ Hσ'] Hv]; cbn in Hv; subst.
     setoid_rewrite interp_state_ret. setoid_rewrite bind_ret_l.
     cbn. setoid_rewrite throw_prefix_ev. setoid_rewrite interp_state_vis.
diff --git a/secure_example/LabelledImpTypes.v b/secure_example/LabelledImpTypes.v
index cdc5040f..941051cf 100644
--- a/secure_example/LabelledImpTypes.v
+++ b/secure_example/LabelledImpTypes.v
@@ -1,4 +1,4 @@
-From Coq Require Import Morphisms String.
+From Stdlib Require Import Morphisms String.
 
 From ITree Require Import
      ITree
@@ -88,7 +88,7 @@ Global Instance proper_state_equiv_label_state_sec_eutt {R1 R2 RR priv l} : Prop
 Proof.
   repeat intro. split.
   - intros. do 2 red in H1. do 2 red. intros. red in H0. specialize (H0 σ2). red in H.
-    specialize (H σ1). eapply proper_eutt_secure_eutt; eauto. symmetry. auto. symmetry. auto.
+  specialize (H σ1). eapply proper_eutt_secure_eutt; eauto. rewrite <- H, <- H0. apply H1; eauto.   
   - intros. intros. do 2 red in H1. do 2 red. intros. red in H0. specialize (H0 σ2). red in H.
     specialize (H σ1).  eapply proper_eutt_secure_eutt; eauto.
 Qed.
@@ -198,7 +198,7 @@ Proof.
     cbn in *. etransitivity; eauto. destruct REL1. destruct REL2.  cbn in *. etransitivity; eauto. }
   eapply eqit_secure_trans; eauto. eapply eqit_secure_sym.
   apply eqit_secure_RR_imp with (RR1 := Rst).
-  { intros. split. 2 : cbv; auto. unfold Rst in PR. destruct PR.
+  { intros x0 x1 PR. split. 2 : cbv; auto. unfold Rst in PR. destruct PR.
     symmetry. auto. destruct x0. destruct x1. unfold Rst in *. destruct PR. symmetry. auto. }
   assert (eqit_secure _ (priv_exc_io Labels) Rst true true observer (Ret (s2, r2) ) (Ret (s2,r1))).
   { apply secure_eqit_ret. unfold Rst in *. split; auto; cbv; auto. symmetry. auto. }
@@ -206,7 +206,7 @@ Proof.
   { intros [? ?] [? ?] [? ?]. destruct r3. cbn in *. unfold Rst in *.
     split. 2 : cbv; auto. destruct REL1 as [REL1 _]. destruct REL2 as [REL2 _].
     cbn in *. etransitivity; eauto. destruct REL1. destruct REL2. etransitivity; eauto. }
-  eapply eqit_secure_trans; try apply Hr2; eauto. reflexivity.
+  eapply eqit_secure_trans; try apply Hr2; eauto.
 Qed.
 
 Lemma state_secure_eutt_throw_ret_aux:
@@ -267,7 +267,7 @@ Lemma state_secure_eutt_ret_aux:
                   (interp_state (handle_imp _) t2 σ2).
 Proof.
   intros R t1 t2 observer r1 r2 Hr1 Hr2 s1 s2 Hs12.
-  eapply state_secure_eutt_equiv_ret_aux; eauto. 2: cbv; auto.
+  eapply state_secure_eutt_equiv_ret_aux; eauto.
   constructor; constructor.
 Qed.
 
@@ -906,7 +906,7 @@ Proof.
     split; auto.
   - right; auto. unfold sem_stmt, interp_imp. do 2 red. intros.
     cbn. setoid_rewrite interp_state_ret. apply secure_eqit_ret; auto.
-    split; auto. cbv. auto.
+    split; auto; cbv; auto.
 Qed.
 
 Lemma well_typed_skip' pc : secure_throw_stmt pc Skip.
@@ -1028,8 +1028,7 @@ Proof.
       intros. setoid_rewrite interp_state_ret. apply secure_eqit_ret.
       split; auto.
     + right; auto. exists 0. unfold sem_expr. cbn. unfold interp_imp. do 2 red.
-      intros. setoid_rewrite interp_state_ret. apply secure_eqit_ret. split; auto.
-      cbv. auto.
+      intros. setoid_rewrite interp_state_ret. apply secure_eqit_ret. split; auto; cbv; auto.
   - inv Htype.
     assert (well_typed_expr l e1 ). eapply well_typed_expr_upward_close; eauto.
     eapply leq_trans_lat with (l2 := join l1 l2); auto. apply leq_join_l; auto.
diff --git a/secure_example/LabelledImpTypesProgInsens.v b/secure_example/LabelledImpTypesProgInsens.v
index fc778e65..15577401 100644
--- a/secure_example/LabelledImpTypesProgInsens.v
+++ b/secure_example/LabelledImpTypesProgInsens.v
@@ -1,4 +1,4 @@
-From Coq Require Import Morphisms.
+From Stdlib Require Import Morphisms.
 
 From ITree Require Import
      ITree
@@ -68,7 +68,7 @@ Definition state_equiv {E R} (m1 m2 : stateT map (itree E) R) := forall (σ : ma
 Global Instance proper_eutt_pi_secure_eutt  {E R1 R2 RR Label priv l} : Proper (@eutt E R1 R1 eq ==> @eutt E R2 R2 eq ==> Basics.flip Basics.impl)
                                                                (pi_eqit_secure Label priv RR true true l).
 Proof.
-  eapply pi_eqit_secure_eq_itree_proper. all : apply true.
+  eapply pi_eqit_secure_eutt_proper. all : apply true.
 Qed.
 
 Global Instance proper_eq_itree_secure_eutt  {E R1 R2 RR Label priv l} : Proper (@eq_itree E R1 R1 eq ==> @eq_itree E R2 R2 eq ==> Basics.flip Basics.impl)
@@ -82,7 +82,7 @@ Global Instance proper_state_equiv_label_state_sec_eutt {R1 R2 RR priv l} : Prop
 Proof.
   repeat intro. split.
   - intros. do 2 red in H1. do 2 red. intros. red in H0. specialize (H0 σ2). red in H.
-    specialize (H σ1). eapply proper_eutt_pi_secure_eutt; eauto. symmetry. auto. symmetry. auto.
+    specialize (H σ1). eapply proper_eutt_pi_secure_eutt; [ symmetry; apply H | symmetry; apply H0 | apply H1; auto ].
   - intros. intros. do 2 red in H1. do 2 red. intros. red in H0. specialize (H0 σ2). red in H.
     specialize (H σ1).  eapply proper_eutt_pi_secure_eutt; eauto.
 Qed.
@@ -243,14 +243,14 @@ Proof.
   specialize (Hs1 observer). inv Hs1.
   - left; auto. unfold sem_stmt, interp_imp.
     cbn. do 2 red. intros σ1 σ2 Hσ. setoid_rewrite interp_state_bind.
-    eapply pi_eqit_secure_bind; eauto. intros [σ3 [] ] [σ4 [] ] [Hσ' _ ].
+    eapply pi_secure_eqit_bind'; eauto. intros [σ3 [] ] [σ4 [] ] [Hσ' _ ].
     specialize (Hs2 observer). inv Hs2; eauto. cbn. do 2 red in H2. cbn in H2.
     eapply pi_sem_stmt_ret_aux; eauto.
   - right; auto. cbn in H0. unfold sem_stmt, interp_imp. cbn.
     do 2 red. intros σ1 σ2 Hσ.
     setoid_rewrite <- bind_ret_r with (s := Ret (σ2, tt) ).
     setoid_rewrite interp_state_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [σ3 [] ] [σ4 [] ] [Hσ' _ ].
     specialize (Hs2 observer). inv Hs2; eauto.
     + exfalso. apply H. eapply leq_trans_lat; eauto.
@@ -267,7 +267,7 @@ Proof.
   - left; auto. unfold sem_throw_stmt, interp_imp. cbn. do 2 red.
     intros σ1 σ2 Hσ. setoid_rewrite throw_prefix_bind.
     setoid_rewrite interp_state_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [σ3 r1] [σ4 r2] [Hσ' Hr]. inv Hr.
     + specialize (Hs2 observer). inv Hs2; eauto.
       * cbn.
@@ -290,7 +290,7 @@ Proof.
       |- pi_eqit_secure _ _ _ _ _ _ _ ?t => assert (t ≈ ITree.bind (Ret (σ4,tt) ) (fun '(σ',x) => Ret (σ', inr lpriv) )) end.
         rewrite bind_ret_l. reflexivity.
         rewrite H7. rewrite <- bind_ret_r.
-        eapply pi_eqit_secure_bind; eauto.
+        eapply pi_secure_eqit_bind'; eauto.
         intros [σ5 r3] [σ6 r4] [Hσ'' Hr']; inv Hr'.
         -- cbn in H8. subst. apply pi_eqit_secure_ret. split; auto.
            constructor; auto. eapply leq_trans_lat; eauto. apply leq_join_l; auto.
@@ -306,7 +306,7 @@ Proof.
         |- pi_eqit_secure _ _ _ _ _ _ ?t _ => assert (t ≈ ITree.bind (Ret (σ3,tt) ) (fun '(σ',x) => Ret (σ', inr lpriv) )) end.
         rewrite bind_ret_l. reflexivity. rewrite H7.
         setoid_rewrite <- bind_ret_r at 4.
-        apply pi_eqit_secure_sym. symmetry in Hσ'. eapply pi_eqit_secure_bind; eauto.
+        apply pi_eqit_secure_sym. symmetry in Hσ'. eapply pi_secure_eqit_bind'; eauto.
         intros [σ5 r3] [σ6 [] ] [Hσ'' Hr']; inv Hr'.
         -- cbn in H8. subst. apply pi_eqit_secure_ret. split; auto. symmetry. auto.
            constructor; auto. eapply leq_trans_lat; eauto. apply leq_join_l; auto.
@@ -316,7 +316,7 @@ Proof.
   - right; auto. intros σ1 σ2 Hσ. unfold sem_throw_stmt, interp_imp.
     cbn. setoid_rewrite throw_prefix_bind. setoid_rewrite interp_state_bind.
     cbn in H0. rewrite <- bind_ret_r with (s := Ret (σ2, tt) ).
-    eapply pi_eqit_secure_bind; eauto. intros [σ3 r1] [σ4 [] ] [Hσ' Hr]. inv Hr.
+    eapply pi_secure_eqit_bind'; eauto. intros [σ3 r1] [σ4 [] ] [Hσ' Hr]. inv Hr.
     -- cbn in H1. subst. cbn. specialize (Hs2 observer). inv Hs2.
        ++ exfalso. apply H. eapply leq_trans_lat; eauto. apply leq_join_l; auto.
        ++ cbn in H2. eapply lower_lexn_sound'; eauto. apply leq_join_r; auto.
@@ -335,7 +335,7 @@ Proof.
   inv Hs1; inv Hs1t; try contradiction.
   - left; auto. unfold sem_stmt, interp_imp. do 2 red. intros σ1 σ2 Hσ.
     cbn. setoid_rewrite try_catch_to_throw_prefix.
-    setoid_rewrite interp_state_bind. eapply pi_eqit_secure_bind; eauto.
+    setoid_rewrite interp_state_bind. eapply pi_secure_eqit_bind'; eauto.
     intros [σ3 r1 ] [σ4 r2 ] [Hσ' Hr] ; inv Hr; cbn.
     + setoid_rewrite interp_state_ret. apply pi_eqit_secure_ret. split; auto.
     + specialize (Hs2 observer). inv Hs2; eauto. do 2 red in H8.
@@ -345,14 +345,14 @@ Proof.
         eapply leq_trans_lat; auto. apply leq_join_r; auto. eauto.
       * apply pi_eqit_secure_sym. do 2 red in H8.
         apply pi_eqit_secure_RR_imp with (RR1 := product_rel (labelled_equiv Γ observer) top2).
-        { intros [? [] ] [? [] ] ? . inv H9. split; auto. symmetry. auto. }
+        { intros [? [] ] [? [] ] ? . inv H9; split; auto; try (symmetry; auto). }
         cbn in H8. setoid_rewrite interp_state_ret. eapply H8. symmetry. auto.
     + specialize (Hs2 observer). inv Hs2.
       * exfalso. apply H4. eapply leq_trans_lat; eauto.
         eapply leq_trans_lat; auto. apply leq_join_r; auto. eauto.
       * do 2 red in H8.
         apply pi_eqit_secure_RR_imp with (RR1 := product_rel (labelled_equiv Γ observer) top2).
-        { intros [? [] ] [? [] ] ? . inv H9. split; auto. }
+        { intros [? [] ] [? [] ] ? . inv H9; split; auto. }
         cbn in H8. setoid_rewrite interp_state_ret. eapply H8. auto.
   - right; auto. unfold sem_stmt, interp_imp. do 2 red. intros σ1 σ2 Hσ.
     cbn. setoid_rewrite try_catch_to_throw_prefix.
@@ -361,9 +361,9 @@ Proof.
       |- pi_eqit_secure _ _ _ _ _ _ _ ?t => assert (t ≈ ITree.bind (Ret (σ2,tt) ) (fun x => Ret x)) end.
     rewrite bind_ret_r. reflexivity. rewrite H3.
     setoid_rewrite interp_state_bind. cbn in H2.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [σ3 r1] [σ4 [] ] [Hσ' Hr]; inv Hr.
-    + tau_steps. apply pi_eqit_secure_ret. split; auto. cbv. auto.
+    + tau_steps. apply pi_eqit_secure_ret. split; auto; cbv; auto.
     + specialize (Hs2 observer). inv Hs2; eauto.
       * exfalso. apply H. eapply leq_trans_lat; eauto. apply leq_join_l; auto.
       * cbn in H8. eauto.
@@ -381,7 +381,7 @@ Proof.
     setoid_rewrite try_catch_to_throw_prefix.
     setoid_rewrite throw_prefix_bind.
     repeat setoid_rewrite interp_state_bind. setoid_rewrite bind_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [σ3 r1] [σ4 r2] [Hσ' Hr]; inv Hr; cbn;
       try setoid_rewrite throw_prefix_ret; try setoid_rewrite interp_state_ret;
         try setoid_rewrite bind_ret_l; cbn.
@@ -397,7 +397,7 @@ Proof.
         match goal with
         |- pi_eqit_secure _ _ _ _ _ _ _ ?t => assert (t ≈ ITree.bind (Ret (σ3, tt) ) (fun '(σ, x) => Ret (σ, inl x) ) ) end.
         rewrite bind_ret_l. reflexivity. rewrite H9.
-        rewrite <- bind_ret_r. symmetry in Hσ'. eapply pi_eqit_secure_bind; eauto.
+        rewrite <- bind_ret_r. symmetry in Hσ'. eapply pi_secure_eqit_bind'; eauto.
         intros [σ5 r] [σ6 [] ] Hr. inv Hr. inv H11.
         -- apply pi_eqit_secure_ret. split. symmetry. auto. cbn in H12. subst.
            constructor.
@@ -410,7 +410,7 @@ Proof.
          match goal with
         |- pi_eqit_secure _ _ _ _ _ _ _ ?t => assert (t ≈ ITree.bind (Ret (σ4, tt) ) (fun '(σ, x) => Ret (σ, inl x) ) ) end.
         rewrite bind_ret_l. reflexivity. rewrite H9. cbn in H8.
-        rewrite <- bind_ret_r. eapply pi_eqit_secure_bind; eauto.
+        rewrite <- bind_ret_r. eapply pi_secure_eqit_bind'; eauto.
         intros [σ5 r] [σ6 [] ] Hr. inv Hr. inv H11.
         -- cbn in H12. subst. apply pi_eqit_secure_ret. constructor.
            auto. constructor.
@@ -423,7 +423,7 @@ Proof.
     rewrite bind_bind.
     setoid_rewrite <- bind_ret_r with (s := Ret (σ2, tt) ).
     cbn in H2.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [σ3 r1] [σ4 r2] [Hσ' Hr]; inv Hr.
     + rewrite throw_prefix_ret, interp_state_ret, bind_ret_l. cbn.
       rewrite interp_state_ret. apply pi_eqit_secure_ret. split; auto.
@@ -453,11 +453,11 @@ Proof.
   specialize (expr_only_ret' Labels e σ3) as [n Hn]. setoid_rewrite Hn.
   rewrite bind_ret_l. destruct n.
   + cbn. rewrite interp_state_ret, bind_ret_l. cbn. apply pi_eqit_secure_ret.
-    constructor. split; auto. cbv. auto.
+    constructor. split; auto; cbv; auto.
   + cbn. rewrite interp_state_bind. rewrite bind_bind.
     rewrite <- (bind_ret_r (Ret (σ2, tt))).
     cbn in H0.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [σ4 [] ] [σ5 [] ] [Hσ' _ ]. rewrite interp_state_ret, bind_ret_l. cbn.
     apply pi_eqit_secure_ret. constructor. split; auto.
 Qed.
@@ -492,7 +492,7 @@ Proof.
   + rewrite throw_prefix_bind. rewrite interp_state_bind. rewrite bind_bind.
     rewrite <- (bind_ret_r (Ret (σ2, tt))).
     cbn in H0.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [σ4 r1] [σ5 r2] [Hσ' Hr]; inv Hr.
     * cbn in H. subst. tau_steps. apply pi_eqit_secure_ret.
       constructor; auto. split; auto. destruct r2. auto.
@@ -509,21 +509,20 @@ Proof.
   - left. eapply leq_trans_lat; try apply H; auto. apply leq_join_l; auto.
     do 2 red. intros σ1 σ2 Hσ. unfold sem_stmt, interp_imp. cbn.
     specialize (@interp_state_iter') as Hisi. red in Hisi. setoid_rewrite Hisi.
-    apply secure_eqit_iter with (RA := product_rel (labelled_equiv Γ observer) eq );
-      auto.
-    clear σ1 σ2 Hσ. intros [σ1 [] ] [σ2 [] ] [Hσ _ ].
-    cbn. setoid_rewrite interp_state_bind. repeat rewrite bind_bind.
-    eapply pi_eqit_secure_bind; eauto.
-    intros [σ3 v1] [σ4 v2] [Hσ' Hv]; cbn in Hv; subst. cbn.
-    destruct v2.
-    + setoid_rewrite interp_state_ret. setoid_rewrite bind_ret_l.
-      cbn. apply pi_eqit_secure_ret. constructor. split; auto.
-    + setoid_rewrite interp_state_bind. setoid_rewrite bind_bind.
-      eapply pi_eqit_secure_bind; eauto.
-      intros [σ5 [] ] [σ6 [] ] [Hσ'' _ ]. setoid_rewrite interp_state_ret.
-      setoid_rewrite bind_ret_l. cbn. apply pi_eqit_secure_ret.
-      constructor; split; auto.
+    apply secure_eqit_iter with (RA := product_rel (labelled_equiv Γ observer) eq ).
     + split; auto.
+    + clear σ1 σ2 Hσ. intros [σ1 [] ] [σ2 [] ] [Hσ _ ].
+      cbn. setoid_rewrite interp_state_bind. repeat rewrite bind_bind.
+      eapply pi_secure_eqit_bind'; eauto.
+      intros [σ3 v1] [σ4 v2] [Hσ' Hv]; cbn in Hv; subst. cbn.
+      destruct v2.
+      ++ setoid_rewrite interp_state_ret. setoid_rewrite bind_ret_l.
+         cbn. apply pi_eqit_secure_ret. constructor. split; auto.
+      ++ setoid_rewrite interp_state_bind. setoid_rewrite bind_bind.
+         eapply pi_secure_eqit_bind'; eauto.
+         intros [σ5 [] ] [σ6 [] ] [Hσ'' _ ]. setoid_rewrite interp_state_ret.
+         setoid_rewrite bind_ret_l. cbn. apply pi_eqit_secure_ret.
+         constructor; split; auto.
   - exfalso. apply H1.
     eapply leq_trans_lat with (l2 := join le lexn); eauto.
     apply leq_join_l; auto.
@@ -552,19 +551,19 @@ Proof.
     do 2 red. intros σ1 σ2 Hσ. unfold sem_throw_stmt, interp_imp. cbn.
     setoid_rewrite throw_prefix_iter.
     specialize (@interp_state_iter') as Hisi. red in Hisi. setoid_rewrite Hisi.
-    eapply secure_eqit_iter with (RA := product_rel (labelled_equiv Γ observer) eq ); auto.
+    eapply secure_eqit_iter with (RA := product_rel (labelled_equiv Γ observer) eq ). 1: split; auto.
     intros [σ3 [] ] [σ4 [] ] [Hσ' _ ]. cbn. setoid_rewrite throw_prefix_bind.
     repeat setoid_rewrite interp_state_bind. repeat rewrite bind_bind.
     setoid_rewrite throw_prefix_denote_expr. setoid_rewrite interp_state_bind.
     setoid_rewrite bind_bind.
-    eapply pi_eqit_secure_bind; eauto. intros [σ5 v1] [σ6 v2] [Hσ'' Hv]; cbn in Hv; subst.
+    eapply pi_secure_eqit_bind'; eauto. intros [σ5 v1] [σ6 v2] [Hσ'' Hv]; cbn in Hv; subst.
     setoid_rewrite interp_state_ret. setoid_rewrite bind_ret_l. cbn.
     destruct v2; cbn.
     + setoid_rewrite throw_prefix_ret. tau_steps.
       apply pi_eqit_secure_ret. constructor. split; auto. constructor.
     + setoid_rewrite throw_prefix_bind. setoid_rewrite interp_state_bind.
       setoid_rewrite bind_bind.
-      eapply pi_eqit_secure_bind; eauto.
+      eapply pi_secure_eqit_bind'; eauto.
       intros [σ7 r1] [σ8 r2] [Hσ''' Hr]. cbn in Hr. inv Hr.
       * setoid_rewrite throw_prefix_ret. tau_steps.
         apply pi_eqit_secure_ret. constructor. split; auto.
@@ -580,7 +579,6 @@ Proof.
         eapply leq_trans_lat; try apply H; auto.
         eapply leq_trans_lat with (l2 := join le lexn); eauto.
         apply leq_join_r; auto. apply leq_join_r; auto.
-    + split; auto.
   - exfalso. apply H1. eapply leq_trans_lat; eauto.
     eapply leq_trans_lat with (l2 := join le lexn); auto.
     apply leq_join_l; auto. apply leq_join_r; auto.
@@ -611,7 +609,7 @@ Proof.
     apply leq_join_l; auto.
     intros σ1 σ2 Hσ. unfold sem_stmt, interp_imp.
     cbn. setoid_rewrite interp_state_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [σ3 v1] [σ4 v2] [Hσ' Hv]; cbn in Hv; subst.
     destruct v2; cbn; eauto.
   - exfalso. apply H3. eapply leq_trans_lat; eauto.
@@ -652,7 +650,7 @@ Proof.
     rewrite throw_prefix_denote_expr.
     repeat setoid_rewrite interp_state_bind.
     repeat setoid_rewrite bind_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [σ3 v1] [σ4 v2] [Hσ' Hv]; cbn in Hv; subst.
     setoid_rewrite interp_state_ret. setoid_rewrite bind_ret_l.
     cbn. destruct v2; eauto.
@@ -709,7 +707,7 @@ Proof.
     + right; auto.
       exists 0. do 2 red. intros. cbn.
       specialize (expr_only_ret' Labels e σ1) as [n Hn]. rewrite Hn.
-      apply pi_eqit_secure_ret. split; auto. cbv. auto.
+      apply pi_eqit_secure_ret. split; auto; cbv; auto.
   - case_leq l2 observer.
     + left; auto. exfalso. apply H. eapply leq_trans_lat; eauto.
     + right; auto.
@@ -731,7 +729,7 @@ Proof.
   - left. eapply leq_trans_lat; eauto.
     do 2 red in H0. do 2 red. intros. unfold sem_stmt.
     cbn. unfold interp_imp.
-    setoid_rewrite interp_state_bind. eapply pi_eqit_secure_bind; eauto.
+    setoid_rewrite interp_state_bind. eapply pi_secure_eqit_bind'; eauto.
     intros [σ3 v1] [σ4 v2] [Hσ Hv]; cbn in Hv; subst.
     setoid_rewrite interp_state_trigger. cbn. apply pi_eqit_secure_ret.
     split; auto. cbn. eapply update_labelled_equiv_visible; auto.
@@ -773,7 +771,7 @@ Proof.
     setoid_rewrite throw_prefix_denote_expr.
     setoid_rewrite interp_state_bind.
     setoid_rewrite interp_state_bind. repeat rewrite bind_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [σ3 v1] [σ4 v2] [Hσ Hv]; cbn in Hv; subst.
     setoid_rewrite interp_state_ret. setoid_rewrite bind_ret_l. cbn.
     setoid_rewrite throw_prefix_ev.
@@ -822,7 +820,7 @@ Proof.
   - left. eapply leq_trans_lat; eauto.
     unfold sem_stmt, interp_imp. intros σ1 σ2 Hσ.
     cbn. setoid_rewrite interp_state_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [σ3 v1] [σ4 v4] [Hσ' Hv]; cbn in Hv; subst.
     cbn. setoid_rewrite interp_state_trigger. cbn.
     setoid_rewrite bind_trigger. apply pi_eqit_secure_pub_vis.
@@ -840,7 +838,7 @@ Proof.
       specialize (expr_only_ret' Labels e σ1) as [n1 Hn1]. setoid_rewrite Hn1.
       rewrite bind_ret_l. rewrite interp_state_trigger. cbn. rewrite bind_trigger.
       apply pi_eqit_secure_priv_visl; auto. intros [].
-      apply pi_eqit_secure_ret. split; auto. cbv. auto.
+      apply pi_eqit_secure_ret. split; auto; cbv; auto.
 Qed.
 
 Lemma print_well_typed_correct' pc le lp e :
@@ -861,7 +859,7 @@ Proof.
     cbn. setoid_rewrite throw_prefix_bind. setoid_rewrite interp_state_bind.
     setoid_rewrite throw_prefix_denote_expr. setoid_rewrite interp_state_bind.
     repeat rewrite bind_bind.
-    eapply pi_eqit_secure_bind; eauto.
+    eapply pi_secure_eqit_bind'; eauto.
     intros [σ3 v1] [σ4 v4] [Hσ' Hv]; cbn in Hv; subst.
     setoid_rewrite interp_state_ret. setoid_rewrite bind_ret_l.
     cbn. setoid_rewrite throw_prefix_ev. setoid_rewrite interp_state_vis.
@@ -910,7 +908,7 @@ Proof.
     split; auto.
   - right; auto. do 2 red. unfold sem_stmt. intros σ1 σ2 Hσ.
     cbn. setoid_rewrite interp_state_ret. apply pi_eqit_secure_ret.
-    split; auto. cbv. auto.
+    split; auto; cbv; auto.
 Qed.
 
 Lemma skip_well_typed_correct' pc :
diff --git a/secure_example/Lattice.v b/secure_example/Lattice.v
index 2a7e09e5..ebc40c4b 100644
--- a/secure_example/Lattice.v
+++ b/secure_example/Lattice.v
@@ -1,4 +1,4 @@
-From Coq Require Import Morphisms.
+From Stdlib Require Import Morphisms.
 
 From ITree.Extra Require Import Secure.Labels.
 
@@ -57,14 +57,13 @@ Lemma leq_join_l (Lat : Lattice) {HLat : LatticeLaws Lat}  (l1 l2 : L) :
   leq l1 (join l1 l2).
 Proof.
   cbn. assert (LatticeLaws Lat). auto. destruct HLat. rewrite join_assoc0. rewrite join_idempot; auto.
-  reflexivity.
 Qed.
 
 Lemma leq_join_r (Lat : Lattice) {HLat : LatticeLaws Lat}  (l1 l2 : L) :
   leq l2 (join l1 l2).
 Proof.
   cbn. assert (LatticeLaws Lat). auto. destruct HLat. rewrite join_comm0. rewrite <- join_assoc0.
-  rewrite join_idempot; auto. reflexivity.
+  rewrite join_idempot; auto. 
 Qed.
 
 Lemma leq_refl_lat (Lat : Lattice) {HLat : LatticeLaws Lat} l :
diff --git a/secure_example/Utils_tutorial.v b/secure_example/Utils_tutorial.v
index 21368f6c..e0d3af34 100644
--- a/secure_example/Utils_tutorial.v
+++ b/secure_example/Utils_tutorial.v
@@ -14,7 +14,7 @@
 *)
 
 (* begin hide *)
-From Coq Require Import Lia Arith ZArith Ascii String List.
+From Stdlib Require Import Lia Arith ZArith Ascii String List.
 
 From ExtLib Require Import
      Structures.Monad
diff --git a/theories/Axioms.v b/theories/Axioms.v
index 2efd869b..f13065e0 100644
--- a/theories/Axioms.v
+++ b/theories/Axioms.v
@@ -3,7 +3,7 @@
 (** Other ITree modules should import this to avoid accidentally using more
    axioms elsewhere. *)
 
-From Coq Require Import
+From Stdlib Require Import
   Logic.Classical_Prop
   Logic.ClassicalChoice
   Logic.EqdepFacts
@@ -11,7 +11,7 @@ From Coq Require Import
 .
 
 (* Must be imported to use [ddestruction] *)
-From Coq Require Export
+From Stdlib Require Export
   Program.Equality
 .
 
@@ -32,7 +32,7 @@ Definition choice := ClassicalChoice.choice.
 
 Definition functional_extensionality := @FunctionalExtensionality.functional_extensionality.
 
-(* From Coq.Logic.ChoiceFacts *)
+(* From Stdlib.Logic.ChoiceFacts *)
 Definition GuardedFunctionalChoice_on {A B} :=
   forall P : A -> Prop, forall R : A -> B -> Prop,
     inhabited B ->
diff --git a/theories/Basics/Basics.v b/theories/Basics/Basics.v
index c178f97a..9d365466 100644
--- a/theories/Basics/Basics.v
+++ b/theories/Basics/Basics.v
@@ -3,10 +3,10 @@
 (** Not specific to itrees. *)
 
 (* begin hide *)
-From Coq Require
+From Stdlib Require
      Ensembles.
 
-From Coq Require Import
+From Stdlib Require Import
      RelationClasses.
 
 From ExtLib Require Import
@@ -38,6 +38,7 @@ Notation "E ~> F" := (forall T, E T -> F T)
   (at level 99, right associativity, only parsing) : type_scope.
 (* The same level as [->]. *)
 (* This might actually not be such a good idea. *)
+(* TODO: Determine if this is, or not, a good idea. *)
 
 (** Identity morphism. *)
 Definition idM {E : Type -> Type} : E ~> E := fun _ e => e.
@@ -166,6 +167,7 @@ Inductive iter_Prop {R I : Type} (step : I -> I + R -> Prop) (i : I) (r : R)
 #[global] Polymorphic Instance MonadIter_Prop : MonadIter Ensembles.Ensemble := @iter_Prop.
 
 (* Elementary constructs for predicates. To be moved in their own file eventually *)
+(* TODO: Make the file to move these into. *)
 Definition equiv_pred {A : Type} (R S: A -> Prop): Prop :=
   forall a, R a <-> S a.
 
diff --git a/theories/Basics/CategoryFacts.v b/theories/Basics/CategoryFacts.v
index 6436229e..194d4848 100644
--- a/theories/Basics/CategoryFacts.v
+++ b/theories/Basics/CategoryFacts.v
@@ -1,7 +1,7 @@
 (** * General facts about categories *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Setoid Morphisms.
 
 From ITree.Basics Require Import
diff --git a/theories/Basics/CategoryFunctor.v b/theories/Basics/CategoryFunctor.v
index b794710e..659f8761 100644
--- a/theories/Basics/CategoryFunctor.v
+++ b/theories/Basics/CategoryFunctor.v
@@ -1,6 +1,6 @@
 (** * Definition of a functor *)
 
-From Coq Require Import
+From Stdlib Require Import
      Setoid
      Morphisms.
 
diff --git a/theories/Basics/CategoryKleisli.v b/theories/Basics/CategoryKleisli.v
index 6b8127c8..c0a26ec9 100644
--- a/theories/Basics/CategoryKleisli.v
+++ b/theories/Basics/CategoryKleisli.v
@@ -15,7 +15,7 @@
  *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Morphisms.
 
 From ExtLib Require Import
diff --git a/theories/Basics/CategoryKleisliFacts.v b/theories/Basics/CategoryKleisliFacts.v
index dbd582ad..f9dbf917 100644
--- a/theories/Basics/CategoryKleisliFacts.v
+++ b/theories/Basics/CategoryKleisliFacts.v
@@ -1,6 +1,6 @@
 (** Proofs that the Kleisli category of a monad is in fact a category. *)
 
-From Coq Require Import
+From Stdlib Require Import
      Program
      Setoid
      Morphisms
diff --git a/theories/Basics/CategoryOps.v b/theories/Basics/CategoryOps.v
index 69ac7613..281be119 100644
--- a/theories/Basics/CategoryOps.v
+++ b/theories/Basics/CategoryOps.v
@@ -113,7 +113,7 @@ Class Initial (i : obj) :=
   empty : forall a, C i a.
 
 (** If there is a terminal object [t], its terminal morphisms are written
-    [one : C a i]. *)
+    [one : C a t]. *)
 Class Terminal (t : obj) :=
   one : forall a, C a t.
 
diff --git a/theories/Basics/CategoryRelations.v b/theories/Basics/CategoryRelations.v
index be9e7e68..7cb20ee2 100644
--- a/theories/Basics/CategoryRelations.v
+++ b/theories/Basics/CategoryRelations.v
@@ -1,4 +1,4 @@
-From Coq Require Import
+From Stdlib Require Import
      Morphisms.
 
 From ITree Require Import
@@ -158,7 +158,7 @@ Section Facts.
 
     Global Instance CatIdL_rel: CatIdL relationH.
     Proof.
-      constructor; unfold subrelationH, cat, id_, Cat_rel, Id_rel, rel_compose; intros.
+      constructor; unfold subrelationH, SubRelH_binary, cat, id_, Cat_rel, Id_rel, rel_compose; intros.
       - edestruct H as (B' & EQ & R). rewrite <- EQ in R.
         assumption.
       - exists x. split. reflexivity. assumption.
@@ -166,7 +166,7 @@ Section Facts.
 
     Global Instance CatIdR_rel: CatIdR relationH.
     Proof.
-      constructor; unfold subrelationH, cat, id_, Cat_rel, Id_rel, rel_compose; intros.
+      constructor; unfold subrelationH, SubRelH_binary, cat, id_, Cat_rel, Id_rel, rel_compose; intros.
       - edestruct H as (B' & R & EQ). rewrite EQ in R.
         assumption.
       - exists y. split. assumption. reflexivity.
@@ -174,7 +174,7 @@ Section Facts.
 
     Global Instance CatAssoc_rel: CatAssoc relationH.
     Proof.
-      constructor; unfold subrelationH, cat, id_, Cat_rel, Id_rel, rel_compose;
+      constructor; unfold subrelationH, SubRelH_binary, cat, id_, Cat_rel, Id_rel, rel_compose;
         intros A D H.
       - edestruct H as (C & (B & Rf & Rg) & Rh); clear H.
         exists B. split; [assumption | ].
@@ -189,7 +189,7 @@ Section Facts.
                 (eq2 ==> eq2 ==> eq2) cat.
     Proof.
       intros a b c.
-      constructor; unfold subrelationH, cat, id_, Cat_rel, Id_rel, rel_compose;
+      constructor; unfold subrelationH, SubRelH_binary, cat, id_, Cat_rel, Id_rel, rel_compose;
         intros A C He.
       - edestruct He as (B & Hx & Hx0).
         unfold eq2, Eq2_rel, eq_rel, subrelationH in *.
@@ -331,7 +331,7 @@ Section Facts.
       - cbv; intros ? ? ?; subst; auto.
         destruct x, y.
         cbv; intros. destruct H; cbn in *; subst; auto.
-      - red. intros. destruct x, y. inversion H. subst. repeat constructor.
+      - cbv. intros [? ?] [? ?] H. inversion H. subst. repeat constructor.
     Qed.
 
     Global Instance BimapCat_prod_rel : BimapCat relationH prod.
@@ -539,7 +539,6 @@ Ltac decomp :=
         3 : refine ((inr (inr c0))). intuition; econstructor; auto.
         intuition.
       - exists (inr (inr d0)); intuition; econstructor; auto.
-        split. Unshelve. econstructor. reflexivity. cbn. auto.
      Qed.
 
     Global Instance Monoidal_sum_rel : Monoidal relationH sum void.
diff --git a/theories/Basics/CategorySub.v b/theories/Basics/CategorySub.v
index a0f156a3..a60633c6 100644
--- a/theories/Basics/CategorySub.v
+++ b/theories/Basics/CategorySub.v
@@ -3,7 +3,7 @@
 (** The category described by a subset of objects of an existing category. *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Setoid
      Morphisms.
 
diff --git a/theories/Basics/CategoryTheory.v b/theories/Basics/CategoryTheory.v
index 90f15adf..40544835 100644
--- a/theories/Basics/CategoryTheory.v
+++ b/theories/Basics/CategoryTheory.v
@@ -4,7 +4,7 @@
     operations, this module describes their properties. *)
 
 (* begin hide *)
-From Coq Require Import Setoid Morphisms.
+From Stdlib Require Import Setoid Morphisms.
 
 From ITree.Basics Require Import
      CategoryOps
diff --git a/theories/Basics/FunctionFacts.v b/theories/Basics/FunctionFacts.v
index 6875ec33..0c419b93 100644
--- a/theories/Basics/FunctionFacts.v
+++ b/theories/Basics/FunctionFacts.v
@@ -1,7 +1,7 @@
 (** * Theorems for [ITree.Basics.Function] *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Morphisms.
 
 From ITree Require Import
diff --git a/theories/Basics/HeterogeneousRelations.v b/theories/Basics/HeterogeneousRelations.v
index 9a30794d..e535b52d 100644
--- a/theories/Basics/HeterogeneousRelations.v
+++ b/theories/Basics/HeterogeneousRelations.v
@@ -1,4 +1,4 @@
-From Coq Require Import
+From Stdlib Require Import
      Morphisms
      Setoid
      Relation_Definitions
@@ -24,9 +24,13 @@ Section RelationH_Operations.
 
   (** ** Relations for morphisms/parametricity *)
 
-  (* Heterogeneous notion of [subrelation] *)
-  Definition subrelationH {A B} (R S : relationH A B) : Prop :=
-    forall (x : A) (y : B), R x y -> S x y.
+  Class SubRelH (T : Type) := subrelationH : T -> T -> Prop.
+
+  #[global] Instance SubRelH_binary (A B : Type) : SubRelH (A -> B -> Prop) :=
+    fun R S => forall (x : A) (y : B), R x y -> S x y.
+
+  #[global] Instance SubRelH_unary (A : Type) : SubRelH (A -> Prop) :=
+    fun P Q => forall x, P x -> Q x.
 
   Definition eq_rel {A B} (R S : relationH A B) :=
       subrelationH R S /\ subrelationH S R.
@@ -38,6 +42,22 @@ Section RelationH_Operations.
   Definition fun_rel {A B: Type} (f: A -> B): relationH A B :=
     fun x y => y = f x.
 
+  Class Conj (T : Type) := conj_rel : T -> T -> T.
+
+  #[global] Instance Conj_binary (A B : Type) : Conj (A -> B -> Prop) :=
+    fun RR1 RR2 x y => RR1 x y /\ RR2 x y.
+
+  #[global] Instance Conj_unary (A : Type) : Conj (A -> Prop) :=
+    fun P1 P2 x => P1 x /\ P2 x.
+
+  Class Disj (T : Type) := disj_rel : T -> T -> T.
+
+  #[global] Instance Disj_binary (A B : Type) : Disj (A -> B -> Prop) :=
+    fun RR1 RR2 x y => RR1 x y \/ RR2 x y.
+
+  #[global] Instance Disj_unary (A : Type) : Disj (A -> Prop) :=
+    fun P1 P2 x => P1 x \/ P2 x.
+
   (** ** Relations for morphisms/parametricity *)
 
   (** Logical relation for the [sum] type. *)
@@ -65,8 +85,10 @@ Arguments fst_rel {A1 A2 B1 B2 RA RB}.
 Arguments snd_rel {A1 A2 B1 B2 RA RB}.
 
 Arguments rel_compose [A B C] S R.
-Arguments subrelationH [A B] R S.
 Arguments transpose [A B] R.
+Arguments subrelationH {T _}.
+Arguments conj_rel {T _}.
+Arguments disj_rel {T _}.
 Arguments sum_rel [A1 A2 B1 B2] RA RB.
 Arguments prod_rel [A1 A2 B1 B2] RA RB.
 
@@ -79,6 +101,8 @@ Module RelNotations.
   Infix "∘" := rel_compose (at level 40, left associativity) : relationH_scope.
   Infix "⊕" := sum_rel (at level 39, left associativity) : relationH_scope.
   Infix "⊗" := prod_rel (at level 38, left associativity) : relationH_scope.
+  Infix "∩" := conj_rel (at level 50, no associativity) : relationH_scope.
+  Infix "∪" := disj_rel (at level 50, no associativity) : relationH_scope.
 
   Infix "⊑" := subrelationH (at level 70, no associativity) : relationH_scope.
   Notation "† R" := (transpose R) (at level 5, right associativity) : relationH_scope.
@@ -246,19 +270,19 @@ Section RelationEqRel.
   #[global]
   Instance eq_rel_Reflexive {A B} : Reflexive (@eq_rel A B).
   Proof.
-    red. unfold eq_rel, subrelationH. tauto.
+    red. unfold eq_rel, subrelationH, SubRelH_binary. tauto.
   Qed.
 
   #[global]
   Instance eq_rel_Symmetric {A B} : Symmetric (@eq_rel A B).
   Proof.
-    red. unfold eq_rel, subrelationH. tauto.
+    red. unfold eq_rel, subrelationH, SubRelH_binary. tauto.
   Qed.
 
   #[global]
   Instance eq_rel_Transitive {A B} : Transitive (@eq_rel A B).
   Proof.
-    red. unfold eq_rel, subrelationH. intros.
+    red. unfold eq_rel, subrelationH, SubRelH_binary. intros.
     destruct H, H0. split; eauto.
   Qed.
 
@@ -411,8 +435,8 @@ Section TransposeFacts.
   Proof.
     intros A B R.
     split.
-    - unfold subrelationH. unfold transpose. tauto.
-    - unfold subrelationH, transpose. tauto.
+    - unfold subrelationH, SubRelH_binary. unfold transpose. tauto.
+    - unfold subrelationH, SubRelH_binary, transpose. tauto.
   Qed.
 
   Lemma transpose_inclusion : forall {A B} (R1 : relationH A B) (R2 : relationH A B),
@@ -421,9 +445,9 @@ Section TransposeFacts.
     intros A B R1 R2.
     split.
     - intros HS.
-      unfold subrelationH, transpose in *. eauto.
+      unfold subrelationH, SubRelH_binary, transpose in *. eauto.
     - intros HS.
-      unfold subrelationH, transpose in *. eauto.
+      unfold subrelationH, SubRelH_binary, transpose in *. eauto.
   Qed.
 
   #[global]
@@ -532,7 +556,7 @@ Section ProdRelFacts.
   Lemma prod_rel_eq : forall (A B:Type),  (@eq A) ⊗ (@eq B) ≡ @eq (A * B).
   Proof.
     intros.
-    unfold eq_rel; split; unfold subrelationH; intros.
+    unfold eq_rel; split; unfold subrelationH, SubRelH_binary; intros.
     - destruct x, y. repeat red in H. destruct H. cbn in *; subst; reflexivity.
     - destruct x; destruct y. cbn in H. repeat red. inversion H. split; reflexivity.
   Qed.
diff --git a/theories/Basics/Monad.v b/theories/Basics/Monad.v
index 68fc2f0c..1e455cb5 100644
--- a/theories/Basics/Monad.v
+++ b/theories/Basics/Monad.v
@@ -1,7 +1,7 @@
 (** * Monad laws and associated typeclasses *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Morphisms.
 
 From ExtLib Require Export
diff --git a/theories/Basics/MonadProp.v b/theories/Basics/MonadProp.v
index 29de11c7..5f19960c 100644
--- a/theories/Basics/MonadProp.v
+++ b/theories/Basics/MonadProp.v
@@ -1,5 +1,5 @@
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Ensembles
      Setoid
      Morphisms.
diff --git a/theories/Basics/MonadState.v b/theories/Basics/MonadState.v
index 40bee1c8..38ab65e9 100644
--- a/theories/Basics/MonadState.v
+++ b/theories/Basics/MonadState.v
@@ -1,5 +1,5 @@
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Setoid
      Morphisms.
 
diff --git a/theories/Basics/Utils.v b/theories/Basics/Utils.v
index 9bfcde64..c3e3b054 100644
--- a/theories/Basics/Utils.v
+++ b/theories/Basics/Utils.v
@@ -1,6 +1,28 @@
-From Paco Require Import paco.
+#[global] Set Warnings "-intuition-auto-with-star".
 
-Ltac inv H := inversion H; clear H; subst.
+From Coinduction Require Import all.
+Require Import Program.Tactics.
+
+Ltac inv H := inversion H; clear H; subst; try easy.
+
+(* [inv], [rewrite_everywhere], [..._except] are general purpose *)
+
+Lemma hexploit_mp: forall P Q: Type, P -> (P -> Q) -> Q.
+Proof. intuition. Defined.
+Ltac hexploit x := eapply hexploit_mp; [eapply x|].
+
+Ltac rewrite_everywhere lem :=
+  progress ((repeat match goal with [H: _ |- _] => rewrite lem in H end); repeat rewrite lem).
+
+Ltac rewrite_everywhere_except lem X :=
+  progress ((repeat match goal with [H: _ |- _] =>
+                 match H with X => fail 1 | _ => rewrite lem in H end
+             end); repeat rewrite lem).
+
+
+Ltac copy h :=
+  let foo := fresh "cpy" in
+  assert (foo := h).
 
 Global Tactic Notation "intros !" := repeat intro.
 
@@ -76,6 +98,13 @@ Ltac eappn f :=
     | [ id: f _ _ _ _ _ _ _ _ |- _ ] => eapply id
     end.
 
+Ltac break H :=
+  repeat match type of H with
+          | exists X, _  => destruct H
+          |  _ /\ _ => destruct H
+          |  _ \/ _ => destruct H
+          |  _ /\ _ => split
+          end.
 
 Ltac crunch :=
   repeat match goal with
@@ -94,14 +123,98 @@ Ltac saturate H :=
                                         clear H; crunch
           end.
 
-Lemma pacobot1 (T0 : Type) (gf : rel1 T0 -> rel1 T0) (r : rel1 T0)
-  : paco1 gf bot1 <1= paco1 gf r.
-Proof.
-  intros x0 H. apply (paco1_mon _ H); contradiction.
-Qed.
-
-Lemma pacobot2 (T0 : Type) (T1 : T0 -> Type) (gf : rel2 T0 T1 -> rel2 T0 T1) (r : rel2 T0 T1)
-  : paco2 gf bot2 <2= paco2 gf r.
-Proof.
-  intros x0 x1 H. eapply (paco2_mon _ H); contradiction.
-Qed.
+(* [coinduction]-like tactics  *)
+
+(* Until https://github.com/damien-pous/coinduction/pull/22 gets merge *)
+Lemma pfp_gfp {X} {L : CompleteLattice X} (b : mon X): b (gfp b) <= (gfp b).
+Proof. apply b_chain. Qed.
+
+  (* in goal: elem -> b elem -> gfp b -> b gfp *)
+
+Ltac step_ :=
+  match goal with
+  | |- gfp ?b ?x ?y ?z => apply ((gfp_fp b x y z))
+  | |- elem ?R ?x ?y ?z => apply (b_chain R x y z)
+  | |- gfp ?b ?x ?y => apply ((gfp_fp b x y))
+  | |- elem ?R ?x ?y => apply (b_chain R x y)
+  | |- gfp ?b ?x => apply ((gfp_fp b x))
+  | |- elem ?R ?x => apply (b_chain R x)
+  end.
+
+Ltac step := match goal with
+    | |- context [gfp ?b] => apply (pfp_gfp b)
+    | |- context [elem ?R] => first [apply (b_chain R) | apply (gfp_bchain R)]
+    end. 
+
+Ltac step_in h :=
+match type of h with
+| context [gfp ?b] => apply (gfp_pfp b) in h
+end.
+
+Tactic Notation "step" "in" ident(h) := step_in h.
+
+Ltac unstep :=
+match goal with
+| |- context [gfp ?b] => apply (gfp_pfp b)
+end.
+
+Ltac unstep_in h :=
+match type of h with
+| context [gfp ?b] => apply (pfp_gfp b) in h
+end.
+
+Tactic Notation "unstep" "in" ident(h) := unstep_in h.
+
+(* Oft-used induction tactic for general IHs. *)
+Tactic Notation "hinduction" hyp(IND) "before" hyp(H)
+  := move IND before H; revert_until IND; induction IND.
+
+Ltac apply_leq := match goal with 
+  | [H : _ <= _ |- _]=> intros; apply H 
+  | [H : leq _ _ |- _]=> intros; apply H 
+end.
+
+(* nonlinear pattern works here *)
+Ltac induct_on_premise := match goal with 
+| H: context [?rel _] |- context [?rel ] => induction H
+end. 
+
+Create HintDb mono. 
+
+Global Hint Extern 4 => apply_leq : mono.
+
+Ltac monauto := (solve [
+(* break `Proper`, introduce names and premises` *)
+cbv; 
+intros; 
+(* find hypothesis matching goal and proceed by cases *)
+solve [induct_on_premise; 
+(* break down each case as necessary. `solve` will backtrack in a helpful way.  *)
+try econstructor; 
+(* use monotonicity fact itself: [sim] <= [sim'] *)
+try apply_leq; 
+eauto]] || fail "`monauto` could not solve this goal."). 
+
+(* TODO: let user add a tactic db here *)
+(* ----------------------------------------------------------------- *)
+
+(* inf_closed automation *)
+Ltac inf_closed_forall_auto :=
+  repeat (apply inf_closed_all; intro).
+
+Ltac inf_closed_impl_auto :=
+  repeat (apply inf_closed_impl; [intros!; apply_leq; firstorder|]).
+
+Ltac inf_closed_final_auto :=
+  solve [repeat intro; try solve [firstorder]; try apply_leq ; firstorder].
+
+Ltac inf_closed_auto :=
+  repeat (inf_closed_forall_auto || inf_closed_impl_auto || inf_closed_final_auto).
+
+(* tower induction always leaves the goal with the form `forall _ : Chain, ...` ; 
+   match on this type and clear the old Chain *) 
+Ltac clear_old_chain := match goal with 
+  | c : ?T |- forall _ : ?T, _ => clear c; intro c end.
+
+Ltac tower_induction := apply tower; [inf_closed_auto|clear_old_chain].
+Tactic Notation "tower" "induction" := tower_induction.
diff --git a/theories/Core/ITreeDefinition.v b/theories/Core/ITreeDefinition.v
index afcf8037..66b677ac 100644
--- a/theories/Core/ITreeDefinition.v
+++ b/theories/Core/ITreeDefinition.v
@@ -4,10 +4,9 @@
 Require Import ExtLib.Structures.Functor.
 Require Import ExtLib.Structures.Applicative.
 Require Import ExtLib.Structures.Monad.
-Require Import Program.Tactics.
 
 From ITree Require Import Basics.
-
+From ITree Require Export Basics.Utils. 
 Set Implicit Arguments.
 Set Contextual Implicit.
 Set Primitive Projections.
@@ -278,28 +277,26 @@ End ITreeNotations.
 
 (** ** Tactics *)
 
-(* [inv], [rewrite_everywhere], [..._except] are general purpose *)
-
-Lemma hexploit_mp: forall P Q: Type, P -> (P -> Q) -> Q.
-Proof. intuition. Defined.
-Ltac hexploit x := eapply hexploit_mp; [eapply x|].
-
-Tactic Notation "hinduction" hyp(IND) "before" hyp(H)
-  := move IND before H; revert_until IND; induction IND.
-
-Ltac rewrite_everywhere lem :=
-  progress ((repeat match goal with [H: _ |- _] => rewrite lem in H end); repeat rewrite lem).
-
-Ltac rewrite_everywhere_except lem X :=
-  progress ((repeat match goal with [H: _ |- _] =>
-                 match H with X => fail 1 | _ => rewrite lem in H end
-             end); repeat rewrite lem).
-
 Ltac genobs x ox := remember (observe x) as ox.
 Ltac genobs_clear x ox := genobs x ox; match goal with [H: ox = observe x |- _] => clear H x end.
-Ltac simpobs := repeat match goal with [H: _ = observe _ |- _] =>
-                    rewrite_everywhere_except (@eq_sym _ _ _ H) H
-                end.
+Ltac simpobs :=
+  repeat match goal with
+  (* would be nice to 'eliminate' any 
+      obs-obs cases from the sarch, but not sure how.
+      maybe backtracking works here? *)
+  (* don't loop on the obs-obs case *)
+  | H : observe _ = observe _ |- _ =>
+    rewrite <- H in *; clear H 
+  | H : _ = observe _ |- _ =>
+    rewrite <- H in *
+  | H : observe _ = _ |- _ =>
+    rewrite H in *
+  | H : _ = _observe _ |- _ =>
+        rewrite <- H in *
+  | H : _observe _ = _ |- _ =>
+    rewrite H in *
+  end.
+(* wishing for an or pattern... *)
 Ltac desobs t H := destruct (observe t) eqn:H.
 
 (** ** Compute with fuel *)
diff --git a/theories/Core/ITreeMonad.v b/theories/Core/ITreeMonad.v
index 8e272245..00f29a0f 100644
--- a/theories/Core/ITreeMonad.v
+++ b/theories/Core/ITreeMonad.v
@@ -7,9 +7,7 @@ From ITree Require Import
      Basics.Basics
      Basics.Monad
      Core.ITreeDefinition
-     Eq.Eqit
-     Eq.UpToTaus.
-
+     Eq.Eqit.
 #[global]
 Instance Eq1_ITree {E} : Eq1 (itree E) := fun a => eutt eq.
 
diff --git a/theories/Core/KTree.v b/theories/Core/KTree.v
index 64a2e12a..78399228 100644
--- a/theories/Core/KTree.v
+++ b/theories/Core/KTree.v
@@ -3,7 +3,7 @@
 (** The Kleisli category of ITrees. *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Morphisms.
 
 From ITree Require Import
@@ -15,7 +15,8 @@ From ITree Require Import
      Basics.Function
      Core.ITreeDefinition
      Eq.Eqit
-     Eq.UpToTaus.
+     .
+
 (* end hide *)
 
 Implicit Types E : Type -> Type.
diff --git a/theories/Core/KTreeFacts.v b/theories/Core/KTreeFacts.v
index a84858e8..53dc6aa8 100644
--- a/theories/Core/KTreeFacts.v
+++ b/theories/Core/KTreeFacts.v
@@ -1,29 +1,28 @@
 (** * Facts about [aloop] and [loop] *)
-
 (* begin hide *)
-From Coq Require Import
+
+From Coinduction Require Import all. 
+
+From Stdlib Require Import
      Classes.Morphisms
      Setoids.Setoid
      Relations.Relations.
 
-From Paco Require Import paco.
-
 From ITree Require Import
-     Basics.Basics
-     Basics.CategoryOps
-     Basics.CategoryTheory
-     Basics.CategoryKleisli
-     Basics.CategoryKleisliFacts
-     Basics.Function
-     Basics.HeterogeneousRelations
-     Core.ITreeDefinition
-     Core.ITreeMonad
-     Core.KTree
-     Eq.Shallow
-     Eq.Eqit
-     Eq.UpToTaus
-     Eq.Paco2.
-
+      Basics.Utils 
+      Basics.Basics
+      Basics.CategoryOps
+      Basics.CategoryTheory
+      Basics.CategoryKleisli
+      Basics.CategoryKleisliFacts
+      Basics.Function
+      Basics.HeterogeneousRelations
+      Core.ITreeDefinition
+      Core.ITreeMonad
+      Core.KTree
+      Eq.Shallow
+      Eq.Eqit
+      .
 Import CatNotations.
 Local Open Scope itree_scope.
 Local Open Scope cat_scope.
@@ -40,6 +39,18 @@ Ltac unfold_ktree :=
 
 (** ** [ITree.aloop] *)
 
+
+From Corelib Require Import Program.Tactics. 
+
+Ltac under_forall' tac := 
+let dummy := fresh "dummy" in   
+assert (dummy : True) by constructor; 
+          intros; 
+          tac; 
+          revert_until dummy; 
+          clear dummy. 
+Ltac to_mon := under_forall' to_mon_core. 
+
 Lemma bind_iter {E A B C} (f : A -> itree E (A + B)) (g : B -> itree E (B + C))
   : forall x,
     (ITree.bind (ITree.iter f x) (ITree.iter g))
@@ -49,21 +60,30 @@ Lemma bind_iter {E A B C} (f : A -> itree E (A + B)) (g : B -> itree E (B + C))
        | inr b => ITree.map (bimap inr (id_ _)) (g b)
        end) (inl x).
 Proof.
-  einit. ecofix CIH. intros.
+  coinduction. 
+  (* this proof should follow from the facts about elem *)
+  intros.
+  (* Unset Printing Notations.  *)
+  (* these rewrites must go through *)
+  (* need eq_itree proper up to everything *)
   rewrite !unfold_iter.
   rewrite bind_map, bind_bind.
-  ebind; econstructor; try reflexivity.
+  ebind. 
   intros [a | b] _ [].
-  - rewrite bind_tau. etau.
+  - rewrite bind_tau. taus.
+    eapply CIH. 
   - rewrite bind_ret_l, tau_euttge.
-    revert b. ecofix CIH'. intros.
+    
+  (* question: why doesn't accumulate acc work? *)
+    do 2 step. revert b. coinduction. intros. 
     rewrite !unfold_iter.
     rewrite bind_map.
-    ebind; econstructor; try reflexivity.
-    intros [b' | c] _ []; cbn.
-    + etau.
+    ebind. 
+    intros [b' | c''] _ []; cbn.
+    + now taus.
     + reflexivity.
-Qed.
+Qed.  
+
 
 Lemma eq_itree_iter' {E I1 I2 R1 R2}
       (RI : I1 -> I2 -> Prop)
@@ -75,11 +95,12 @@ Lemma eq_itree_iter' {E I1 I2 R1 R2}
   : forall (i1 : I1) (i2 : I2) (RI_i : RI i1 i2),
     @eq_itree E _ _ RR (ITree.iter body1 i1) (ITree.iter body2 i2).
 Proof.
-  ginit. pcofix CIH. intros.
+  coinduction c cih. intros. 
   specialize (eutt_body i1 i2 RI_i).
   do 2 rewrite unfold_iter.
-  guclo eqit_clo_bind; econstructor; eauto.
-  intros ? ? []; gstep; econstructor; auto with paco.
+  eapply eqit_bind_chain. 
+  do 2 step. apply eutt_body. 
+  intros ? ? []; econstructor; eauto. 
 Qed.
 
 Lemma eutt_iter' {E I1 I2 R1 R2}
@@ -92,18 +113,17 @@ Lemma eutt_iter' {E I1 I2 R1 R2}
   : forall (i1 : I1) (i2 : I2) (RI_i : RI i1 i2),
     @eutt E _ _ RR (ITree.iter body1 i1) (ITree.iter body2 i2).
 Proof.
-  einit. ecofix CIH. intros.
+  coinduction c CIH. intros. 
   specialize (eutt_body i1 i2 RI_i).
   do 2 rewrite unfold_iter.
-  ebind; econstructor; eauto with paco.
-  intros ? ? [].
-  - etau.
-  - eauto with paco.
+  ebind.
+  do 2 step; eauto. 
+  intros ? ? []; econstructor; eauto. 
 Qed.
 
 Lemma eutt_iter'' {E I1 I2 R1 R2}
       (RI1 RI2 : I1 -> I2 -> Prop)
-      (HSUB: RI2 <2= RI1)
+      (HSUB: RI2 <= RI1)
       (RR : R1 -> R2 -> Prop)
       (body1 : I1 -> itree E (I1 + R1))
       (body2 : I2 -> itree E (I2 + R2))
@@ -112,16 +132,15 @@ Lemma eutt_iter'' {E I1 I2 R1 R2}
   : forall (i1 : I1) (i2 : I2) (RI_i : RI1 i1 i2),
     @eutt E _ _ RR (ITree.iter body1 i1) (ITree.iter body2 i2).
 Proof.
-  einit. ecofix CIH. intros.
+  coinduction c CIH. intros. 
   specialize (eutt_body i1 i2 RI_i).
   do 2 rewrite unfold_iter.
-  ebind; econstructor; eauto with paco.
-  intros ? ? [].
-  - etau.
-  - eauto with paco.
+  ebind. 
+  do 2 step; eauto. 
+  intros ? ? []; econstructor; eauto. now apply CIH, HSUB.
 Qed.
 
-Definition eutt_iter_gen' {F A B R1 R2 S} (HS : R2 <2= R1) :
+Definition eutt_iter_gen' {F A B R1 R2 S} (HS : R2 <= R1) :
   @Proper ((A -> itree F (A + B)) -> A -> itree F B)
           ((R1 ==> eutt (sum_rel R2 S)) ==> R1 ==> (eutt S))
           (iter (C := ktree F)).
@@ -141,7 +160,7 @@ Proof.
   intros body1 body2 EQ_BODY a. repeat red in EQ_BODY.
   unfold_ktree.
   eapply (eq_itree_iter' eq); auto.
-  intros; eapply eqit_mon, EQ_BODY; auto.
+  intros; eapply eqit_mono, EQ_BODY; auto.
   intros [] _ []; auto; econstructor; subst; auto.
 Qed.
 
@@ -153,7 +172,7 @@ Proof.
   intros body1 body2 EQ_BODY a. repeat red in EQ_BODY.
   unfold_ktree.
   eapply (eutt_iter' eq); auto.
-  intros ? _ []; eapply eqit_mon, EQ_BODY; auto.
+  intros ? _ []; eapply eqit_mono, EQ_BODY; auto.
   intros [] _ []; auto; econstructor; auto.
 Qed.
 
@@ -189,7 +208,7 @@ Qed.
 #[global] Instance IterUnfold_ktree {E} : IterUnfold (ktree E) sum.
 Proof.
   repeat intro. unfold_ktree. rewrite unfold_iter_ktree.
-  eapply eutt_clo_bind; try reflexivity.
+  eapply eutt_bind_eutt; try reflexivity.
   intros [] ? []; try rewrite tau_eutt; reflexivity.
 Qed.
 
@@ -197,12 +216,12 @@ Qed.
 Proof.
   repeat intro. unfold_ktree.
   revert a0.
-  einit. ecofix CIH. intros.
+  coinduction c' CIH. intros. 
   rewrite 2 unfold_iter_ktree.
   rewrite !bind_bind.
-  ebind; econstructor; try reflexivity.
+  ebind. 
   intros [] ? [].
-  - rewrite bind_tau, 2 bind_ret_l. etau.
+  - rewrite bind_tau, 2 bind_ret_l. now taus. 
   - rewrite bind_ret_l, !bind_bind. setoid_rewrite bind_ret_l. rewrite bind_ret_r.
     reflexivity.
 Qed.
@@ -226,25 +245,17 @@ Lemma iter_dinatural_ktree {E A B C}
      | inr b => Ret b
      end).
 Proof.
-  revert f g a0.
-  ginit. pcofix CIH. intros.
+  revert A B C f g a0. 
+  coinduction c CIH. intros. 
   rewrite unfold_iter_ktree.
   rewrite bind_bind.
-  guclo eqit_clo_bind. econstructor. try reflexivity.
+  ebind. 
   intros [] ? [].
-  { rewrite bind_tau.
-    (* TODO: here we should be able to apply symmetry and be done. *)
-    rewrite unfold_iter_ktree.
-    gstep; econstructor.
-    rewrite bind_bind.
-    guclo eqit_clo_bind; econstructor; try reflexivity.
-    intros [] ? [].
-    * rewrite bind_tau.
-      gstep; constructor.
-      eauto with paco.
-    * rewrite bind_ret_l. gstep; econstructor; auto.
-  }
-  { rewrite bind_ret_l. gstep; constructor; auto. }
+  (* Tour: show this *)
+  (* old TODO: here we should be able to apply symmetry and be done. *)
+  (* Win! *)
+  - rewrite bind_tau. taus. symmetry. eapply CIH. 
+  - rewrite bind_ret_l. reflexivity. 
 Qed.
 
 #[global] Instance IterDinatural_ktree {E} : IterDinatural (ktree E) sum.
@@ -257,18 +268,18 @@ Proof.
                         | inr b0 => Ret (inr b0)
                         end)) a0).
   - apply eutt_iter; intros x.
-    eapply eutt_clo_bind.
+    eapply eutt_bind_eutt.
     reflexivity.
     intros [] ? [].
     rewrite tau_eutt; reflexivity.
     reflexivity.
   - rewrite iter_dinatural_ktree.
-    eapply eutt_clo_bind.
+    eapply eutt_bind_eutt.
     reflexivity.
     intros [] ? [].
     + rewrite tau_eutt.
       apply eutt_iter; intros x.
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       reflexivity.
       intros [] ? [].
       rewrite tau_eutt; reflexivity.
@@ -287,28 +298,29 @@ Lemma iter_codiagonal_ktree {E A B} (f : ktree E A (A + (A + B))) (a0 : A)
        end)) a0.
 Proof.
   revert a0.
-  ginit. pcofix CIH. intros.
+  coinduction c CIH. intros. 
   rewrite unfold_iter_ktree.
   rewrite (unfold_iter_ktree (fun _ => _ _ _)).
   rewrite unfold_iter_ktree, !bind_bind.
-  guclo eqit_clo_bind. econstructor. reflexivity.
+  ebind. 
   intros [| []] ? [].
   - rewrite bind_ret_l, bind_tau.
-    gstep. constructor.
+    taus. 
     revert a.
-    pcofix CIH'. intros.
+    accumulate acc. 
+    intros.
     rewrite unfold_iter_ktree.
     rewrite (unfold_iter_ktree (fun _ => _ _ _)).
     rewrite !bind_bind.
-    guclo eqit_clo_bind. econstructor. reflexivity.
+    ebind. 
     intros [| []] ? [].
-    + rewrite bind_tau, bind_ret_l. gstep; constructor; auto with paco.
-    + rewrite 2 bind_ret_l. gstep; constructor; auto with paco.
-    + rewrite 2 bind_ret_l. gstep; constructor; auto.
+    + rewrite bind_tau, bind_ret_l. now taus. 
+    + rewrite 2 bind_ret_l. now taus. 
+    + rewrite 2 bind_ret_l. reflexivity. 
   - rewrite 2 bind_ret_l.
-    gstep; constructor; auto with paco.
+    now taus. 
   - rewrite 2 bind_ret_l.
-    gstep; reflexivity.
+    reflexivity. 
 Qed.
 
 #[global] Instance IterCodiagonal_ktree {E} : IterCodiagonal (ktree E) sum.
@@ -317,7 +329,7 @@ Proof.
   rewrite iter_codiagonal_ktree.
   apply eutt_iter.
   intros a1.
-  eapply eutt_clo_bind.
+  eapply eutt_bind_eutt.
   reflexivity.
   intros [| []] ? []; rewrite ?tau_eutt; reflexivity.
 Qed.
@@ -335,33 +347,26 @@ Proof.
   intros *.
   unfold_ktree.
   (* We move to the eworld *)
-  einit.
-  intros.
-  revert a0.
+  repeat red. 
   (* First coinductive point in the simulation: at the entry point of the iteration over f *)
-  ecofix CIH.
-  intros.
-  cbn.
+  coinduction c' CIH. intros.   
   rewrite bind_ret_l.
   (* We unfold one step on both sides *)
-  match goal with
-  |- euttG _ _ _ _ _ ?t _ => remember t; rewrite unfold_iter; subst
-  end.
-  rewrite unfold_iter; cbn.
+  rewrite unfold_iter. 
+  
+  rewrite unfold_iter.
   rewrite !bind_bind.
   ebind.
   (* We run f a first time on both side *)
-  econstructor; [reflexivity | intros [xa | xb] ? <-].
+  intros [xa | xb] ? <-.
   - (* If we loop back to f, we can conclude by coinduction *)
     rewrite ! bind_ret_l.
     rewrite bind_tau.
-    etau.
-    specialize (CIHL xa). cbn in CIHL.
-    match goal with
-      |- euttG _ _ _ _ _ ?t _ => remember t
-    end.
-    rewrite <- bind_ret_l.
-    ebase.
+    taus. 
+    specialize (CIH xa).
+    symmetry. 
+    rewrite <- bind_ret_l. symmetry. 
+    apply CIH. 
   - (* If we exit the first loop *)
     rewrite ! bind_ret_l.
     (* We setup a second coinductive point in the simulation.
@@ -369,25 +374,21 @@ Proof.
        that we have encountered in the right of the equation to keep the second part clean. 
      *)
     rewrite tau_euttge.
+    do 2 step. 
     generalize xb.
-    ecofix CIH'.
-    
-    intros ?.
+    coinduction c'' CIH'. intros. 
     (* We unfold a new step of computation *)
-    rewrite unfold_iter; cbn.
-    match goal with
-      |- euttG _ _ _ _ _ ?t _ => remember t; rewrite unfold_iter; subst
-    end.
-    cbn.
+    rewrite 2 unfold_iter. 
     rewrite !bind_bind.
     (* We run g a first time on both sides *)
     ebind.
-    econstructor; [reflexivity | intros [xb' | xc] ? <-].
+    intros [xb' | xc] ? <-.
     + (* We loop back in the second loop *)
       rewrite !bind_ret_l.
-      etau.
+      taus.
+      apply CIH'.  
     + rewrite !bind_ret_l.
-      eret.
+      reflexivity. 
 Qed.
 
 End KTreeIterative.
diff --git a/theories/Eq.v b/theories/Eq.v
index 12d862a2..b870af7e 100644
--- a/theories/Eq.v
+++ b/theories/Eq.v
@@ -3,6 +3,4 @@
 From ITree.Eq Require Export
   Shallow
   Eqit
-  UpToTaus
-  SimUpToTaus
-  EuttExtras.
+  SimUpToTaus.
diff --git a/theories/Eq/Eqit.v b/theories/Eq/Eqit.v
index e1c00bd0..8690bf0f 100644
--- a/theories/Eq/Eqit.v
+++ b/theories/Eq/Eqit.v
@@ -1,5 +1,4 @@
-
-(** * Strong bisimulation *)
+(** * Bisimulation *)
 
 (** Because [itree] is a coinductive type, the naive [eq] relation
     is too strong: most pairs of "morally equivalent" programs
@@ -15,53 +14,60 @@
  *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Structures.Orders (* Hint Unfold is_true *)
      Program
      Setoid
      Morphisms
      Relations.
 
-From Paco Require Import paco.
+From Coinduction Require Import all.
 
+(* important: Basics.Utils must come after Coinduction, as it 
+re-implements several tactics. *)
 From ITree Require Import
      Basics.Basics
      Basics.Utils
      Basics.HeterogeneousRelations
      Core.ITreeDefinition
-     Eq.Paco2
      Eq.Shallow.
 
-Local Open Scope itree_scope.
-
-(* TODO: Send to paco *)
-#[global] Instance Symmetric_bot2 (A : Type) : @Symmetric A bot2.
-Proof. auto. Qed.
 
-#[global] Instance Transitive_bot2 (A : Type) : @Transitive A bot2.
-Proof. auto. Qed.
+Local Open Scope itree_scope.
 (* end hide *)
 
-(** ** Coinductive reasoning with Paco *)
+(** ** Coinductive reasoning with Pous' Enhanced Coinduction library *)
 
 (** Similarly to the way we deal with cofixpoints explained in
-    [Core.ITreeDefinition], coinductive properties are defined in two steps,
-    as greatest fixed points of monotone relation transformers.
+      [Core.ITreeDefinition], coinductive properties are defined in two steps,
+      as greatest fixed points of monotone relations.
 
-    - a _relation transformer_, a.k.a. _generating function_,
-      is a function mapping relations to relations
-      [gf : (i -> i -> Prop) -> (i -> i -> Prop)];
     - _monotonicity_ is with respect to relations ordered by set inclusion
-      (a.k.a. implication, when viewed as predicates)
-      [(r1 <2= r2) -> (gf r1 <2= gf r2)];
-    - the Paco library provides a combinator [paco2] defining the greatest
-      fixed point [paco2 gf] when [gf] is indeed monotone.
+      (a.k.a. implication, when viewed as predicates) 
+      [(r1 <= r2) ≡ (r1 -> r2)];
+
+    - the [coinduction] library provides a combinator [gfp] defining the
+          greatest fixed point [gfp f] when [f] is indeed monotone.
+
+    The [coinduction] library provides us with elegant machinery for
+    defining a monotone function: we simply need to prove it respects 
+    the [leq] relation on the implicit underlying lattice, though we never
+    need to mention the actual lattice itself. 
 
     By thus avoiding [CoInductive] to define coinductive properties,
-    Paco spares us from thinking about guardedness of proof terms,
-    instead encoding a form of productivity visibly in types.
+    [coinduction] both spares us from thinking about guardedness of proof terms,
+    instead encoding a form of productivity visible in types, and also provides
+    us with a powerful set of tactics for reasoning about observable behaviors.
+
+    We have gone a step further to enrich this set of tactics with our own 
+    definitions specific to ITrees. These can be found in [Basics/Utils.v] 
+    and in this file in the [Tactics] section.
  *)
 
+(** We coerce [b1] and [b2] in [eqitF] (below) from [bool] to [Prop]. This makes
+it slightly easier to write and automate mechanized proofs about [eqit]: we have
+hypotheses of simply [b1] rather than [b1 = true]. *)
+
 Local Coercion is_true : bool >-> Sortclass.
 
 Section eqit.
@@ -74,8 +80,13 @@ Section eqit.
 
       Then the desired equivalence relation is obtained by setting
       [RR := eq] (with [R1 = R2]).
+
+      The lattice on which the greatest fixed point is taken quantifies
+      over types: [forall R1 R2, (R1 -> R2 -> Prop) -> itree E R1 -> itree E R2 -> Prop].
+      This allows chains to work uniformly across all type instantiations,
+      which is essential for the up-to bind principle.
    *)
-  Context {E : Type -> Type} {R1 R2 : Type} (RR : R1 -> R2 -> Prop).
+  Context {E : Type -> Type}.
 
   (** We also need to do some gymnastics to work around the
       two-layered definition of [itree]. We first define a
@@ -87,446 +98,1315 @@ Section eqit.
       pattern-matching is not allowed on [itree].
    *)
 
-  Inductive eqitF (b1 b2: bool) vclo (sim : itree E R1 -> itree E R2 -> Prop) :
+  Inductive eqitF {R1 R2 : Type} (RR : R1 -> R2 -> Prop) (b1 b2: bool) (sim : itree E R1 -> itree E R2 -> Prop) :
     itree' E R1 -> itree' E R2 -> Prop :=
   | EqRet r1 r2
        (REL: RR r1 r2):
-     eqitF b1 b2 vclo sim (RetF r1) (RetF r2)
+     eqitF RR b1 b2 sim (RetF r1) (RetF r2)
   | EqTau m1 m2
         (REL: sim m1 m2):
-      eqitF b1 b2 vclo sim (TauF m1) (TauF m2)
+      eqitF RR b1 b2 sim (TauF m1) (TauF m2)
   | EqVis {u} (e : E u) k1 k2
-        (REL: forall v, vclo sim (k1 v) (k2 v) : Prop):
-      eqitF b1 b2 vclo sim (VisF e k1) (VisF e k2)
+        (REL: forall v, sim (k1 v) (k2 v) : Prop):
+      eqitF RR b1 b2 sim (VisF e k1) (VisF e k2)
   | EqTauL t1 ot2
         (CHECK: b1)
-        (REL: eqitF b1 b2 vclo sim (observe t1) ot2):
-      eqitF b1 b2 vclo sim (TauF t1) ot2
+        (REL: eqitF RR b1 b2 sim (observe t1) ot2):
+      eqitF RR b1 b2 sim (TauF t1) ot2
   | EqTauR ot1 t2
         (CHECK: b2)
-        (REL: eqitF b1 b2 vclo sim ot1 (observe t2)):
-      eqitF b1 b2 vclo sim ot1 (TauF t2)
+        (REL: eqitF RR b1 b2 sim ot1 (observe t2)):
+      eqitF RR b1 b2 sim ot1 (TauF t2)
   .
   Hint Constructors eqitF : itree.
 
-  Definition eqit_ b1 b2 vclo sim :
-    itree E R1 -> itree E R2 -> Prop :=
-    fun t1 t2 => eqitF b1 b2 vclo sim (observe t1) (observe t2).
+  Definition eqit_ b1 b2
+    (sim : forall R1 R2, (R1 -> R2 -> Prop) -> itree E R1 -> itree E R2 -> Prop) :
+    forall R1 R2, (R1 -> R2 -> Prop) -> itree E R1 -> itree E R2 -> Prop :=
+    fun R1 R2 RR t1 t2 => eqitF RR b1 b2 (sim R1 R2 RR) (observe t1) (observe t2).
   Hint Unfold eqit_ : itree.
-
   (** [eqitF] and [eqit_] are both monotone. *)
 
-  Lemma eqitF_mono b1 b2 x0 x1 vclo vclo' sim sim'
-        (IN: eqitF b1 b2 vclo sim x0 x1)
-        (MON: monotone2 vclo)
-        (LEc: vclo <3= vclo')
-        (LE: sim <2= sim'):
-    eqitF b1 b2 vclo' sim' x0 x1.
-  Proof.
-    intros. induction IN; eauto with itree.
-  Qed.
-
-  Lemma eqit__mono b1 b2 vclo (MON: monotone2 vclo) : monotone2 (eqit_ b1 b2 vclo).
-  Proof. do 2 red. intros. eapply eqitF_mono; eauto. Qed.
-
-  Hint Resolve eqit__mono : paco.
+  Lemma eqitF_mono b1 b2 : Proper (leq ==> leq) (eqit_ b1 b2).
+  Proof. monauto. Qed. 
 
-  Lemma eqit_idclo_mono: monotone2 (@id (itree E R1 -> itree E R2 -> Prop)).
-  Proof. unfold id. eauto. Qed.
+  (* The monotone relation `b`. `eqit` is `gfp b`. *)
 
-  Hint Resolve eqit_idclo_mono : paco.
+  Definition eqit_mon b1 b2 : mon (forall R1 R2, (R1 -> R2 -> Prop) -> itree E R1 -> itree E R2 -> Prop) :=
+    {| body := eqit_ b1 b2 ; Hbody := eqitF_mono b1 b2 |}.
 
-  Definition eqit b1 b2 : itree E R1 -> itree E R2 -> Prop :=
-    paco2 (eqit_ b1 b2 id) bot2.
+  Definition eqit {R1 R2} (RR : R1 -> R2 -> Prop) b1 b2 : itree E R1 -> itree E R2 -> Prop :=
+    gfp (eqit_mon b1 b2) R1 R2 RR.
 
   (** Strong bisimulation on itrees. If [eqit RR t1 t2],
       we say that [t1] and [t2] are (strongly) bisimilar. As hinted
       at above, bisimilarity can be intuitively thought of as
       equality. *)
 
-  Definition eq_itree := eqit false false.
+  Definition eq_itree {R1 R2} (RR : R1 -> R2 -> Prop) := eqit RR false false.
 
-  Definition eutt := eqit true true.
+  Definition eutt {R1 R2} (RR : R1 -> R2 -> Prop) := eqit RR true true.
 
-  Definition euttge := eqit true false.
+  Definition euttge {R1 R2} (RR : R1 -> R2 -> Prop) := eqit RR true false.
 
 End eqit.
+Arguments eqit_ {E} b1 b2 sim R1 R2 RR t1 t2/.
+Arguments eqit {E R1 R2} RR b1 b2 _ _.
+Arguments eqit_mon {E} b1 b2. 
+
+
+(** Notation of [eqit] and [eqitF]. You can write
+    [≅] using [[\cong]]
+    [≈] using [[\approx]]
+    [≳] using [[\gtrsim]]
+    in tex-mode.
+    *)
+
+    (* eq_itree and relative functions *)
+    (* gfp *)
+    Infix "≅⟨ R ⟩"   := (eq_itree R) (at level 70) : type_scope.
+    Infix "≅"   := (eq_itree eq) (at level 70) : type_scope.
+    (* b (gfp) *)
+    Infix "{≅⟨ R ⟩}" := (eqitF R false false (eq_itree _)) (at level 70) : type_scope.
+    Infix "{≅}" := (eqitF eq false false (eq_itree _)) (at level 70, only parsing) : type_scope.
+    (* b (elem) *)
+    Infix "{[≅⟨ R ⟩]}" := (eqitF R false false (elem _ _ _ _)) (at level 70) : type_scope.
+    Infix "{[≅]}" := (eqitF eq false false (elem _ _ _ _)) (at level 70, only parsing) : type_scope.
+    (* elem *)
+    Infix "[≅⟨ R ⟩]" := (@elem _ _ (eqit_mon false false) _ _ _ R) (at level 70) : type_scope.
+    Infix "[≅]" := (@elem _ _ (eqit_mon false false) _ _ _ eq) (at level 70) : type_scope.
+
+    (* eutt and relative functions *)
+    (* gfp *)
+    Infix "≈⟨ R ⟩" := (eutt R) (at level 70) : type_scope.
+    Infix "≈" := (eutt eq) (at level 70) : type_scope.
+    (* b (gfp) *)
+    Infix "{≈⟨ R ⟩}" := (eqitF R true true (eutt _)) (at level 70) : type_scope.
+    Infix "{≈}" := (eqitF eq true true (eutt _)) (at level 70, only parsing) : type_scope.
+    (* b (elem) *)
+    Infix "{[≈⟨ R ⟩]}" := (eqitF R true true (elem _ _ _ _)) (at level 70) : type_scope.
+    Infix "{[≈]}" := (eqitF eq true true (elem _ _ _ _)) (at level 70, only parsing) : type_scope.
+    (* elem *)
+    Infix "[≈⟨ R ⟩]" := (@elem _ _ (eqit_mon true true) _ _ _ R) (at level 70) : type_scope.
+    Infix "[≈]" := (@elem _ _ (eqit_mon true true) _ _ _ eq) (at level 70) : type_scope.
+
+    (* euttge and relative functions *)
+    (* gfp *)
+    Infix "≳⟨ R ⟩" := (euttge R) (at level 70) : type_scope.
+    Infix "≳"   := (euttge eq) (at level 70) : type_scope.
+    (* b (gfp) *)
+    Infix "{≳⟨ R ⟩}" := (eqitF R true false (euttge _)) (at level 70) : type_scope.
+    Infix "{≳}" := (eqitF eq true false (euttge _)) (at level 70, only parsing) : type_scope.
+    (* b (elem) *)
+    Infix "{[≳⟨ R ⟩]}" := (eqitF R true false (elem _ _ _ _)) (at level 70) : type_scope.
+    Infix "{[≳]}" := (eqitF eq true false (elem _ _ _ _)) (at level 70, only parsing) : type_scope.
+    (* elem *)
+    Infix "[≳⟨ R ⟩]" := (@elem _ _ (eqit_mon true false) _ _ _ R) (at level 70) : type_scope.
+    Infix "[≳]" := (@elem _ _ (eqit_mon true false) _ _ _ eq) (at level 70) : type_scope.
+
+    (* chains *)
+    Notation euttC := (Chain (eqit_mon true true)).
+    Notation euttgeC := (Chain (eqit_mon true false)).
+    Notation eq_itreeC := (Chain (eqit_mon false false)).
+    
+    (* makes [observe] a bit nicer to look at *)
+    Notation "⊙ x" := (observe x) (only printing, at level 10).
+    
+
+    (* begin hide *)
+    #[global] Hint Constructors eqitF : itree.
+    #[global] Hint Unfold eqit_ : itree.
+    #[global] Hint Unfold eqit_mon : itree.
+    #[global] Hint Unfold eqit : itree.
+    #[global] Hint Unfold eq_itree : itree.
+    #[global] Hint Unfold eutt : itree.
+    #[global] Hint Unfold euttge : itree.
+    
+(** Tactics *)
+
+(** --- Per-relation hooks for the [eqit] family. --- *)
+
+#[local] Ltac iunfold      := unfold euttge, eq_itree, eutt, eqit.
+#[local] Ltac iunfold_in h := unfold euttge, eq_itree, eutt, eqit in h.
+#[local] Ltac iunfold_all  := unfold euttge, eq_itree, eutt, eqit in *.
+
+(* Unfolding tactics for bisimulations. *)
+(* Generally, these are used to go from [eqit_mon] to [eqitF]. *)
+(* Sometimes you will call these manually. *)
+Ltac icbn := repeat red. 
+Ltac icbn_in h := repeat red in h.
+
+(* Used to refold eqit; useful for automation: 
+   sometimes [auto] will not recognize that [eqit] should solve
+   a goal of the shape [gfp (eqit_mon)], 
+   though they are isomorphic up to unfolding. *)
+
+(* Typically, you will not invoke these tactics manually. *)
+Ltac refold :=
+  repeat match goal with
+  | |- context[gfp (@eqit_mon ?E ?b1 ?b2) ?R1 ?R2 ?RR] =>
+      fold (@eqit E R1 R2 RR b1 b2);
+      try fold (@eq_itree E _ _);
+      try fold (@euttge E _ _);
+      try fold (@eutt E _ _)
+  end.
 
-(* begin hide *)
-#[global] Hint Constructors eqitF : itree.
-#[global] Hint Unfold eqit_ : itree.
-#[global] Hint Resolve eqit__mono : paco.
-#[global] Hint Resolve eqit_idclo_mono : paco.
-#[global] Hint Unfold eqit : itree.
-#[global] Hint Unfold eq_itree : itree.
-#[global] Hint Unfold eutt : itree.
-#[global] Hint Unfold euttge : itree.
-#[global] Hint Unfold id : itree.
-
-Lemma eqitF_inv_VisF_r {E R1 R2} (RR : R1 -> R2 -> Prop) {b1 b2 vclo sim}
-    t1 X2 (e2 : E X2) (k2 : X2 -> _)
-  : eqitF RR b1 b2 vclo sim t1 (VisF e2 k2) ->
-    (exists k1, t1 = VisF e2 k1 /\ forall v, vclo sim (k1 v) (k2 v)) \/
-    (b1 /\ exists t1', t1 = TauF t1' /\ eqitF RR b1 b2 vclo sim (observe t1') (VisF e2 k2)).
+Ltac refold_in h :=
+  match type of h with
+  | context[gfp (@eqit_mon ?E ?b1 ?b2) ?R1 ?R2 ?RR] =>
+      fold (@eqit E R1 R2 RR b1 b2) in h;
+      try fold (@eq_itree E _ _) in h;
+      try fold (@euttge E _ _) in h;
+      try fold (@eutt E _ _) in h
+  end.
+
+(* Change [eqitF] to [eqit_mon]. It is a bit complex due to constructors
+   not using [observe] at all times. *)
+
+(* RAB : it would be a nice feature to have _all_ [observe] instances
+   be canonical; i.e. not to have both (observe (Ret r)) and (RetF r).
+   
+   *)
+Ltac to_mon_core :=
+cbn; match goal with
+| |- context[@eqitF ?E ?R1 ?R2 ?RR ?b1 ?b2 (?f ?R1 ?R2 ?RR)
+                   (observe ?t1) (observe ?t2)] =>
+      change (eqitF RR b1 b2 (f R1 R2 RR)
+                    (observe t1) (observe t2))
+      with (eqit_mon b1 b2 f R1 R2 RR t1 t2)
+| |- context[@eqitF ?E ?R1 ?R2 ?RR ?b1 ?b2 (?f ?R1 ?R2 ?RR)
+                   (?con1 ?a1) (?con2 ?a2)] =>
+      change (eqitF RR b1 b2 (f R1 R2 RR)
+                    (con1 a1) (con2 a2))
+      with (eqit_mon b1 b2 f R1 R2 RR
+                    (go (con1 a1)) (go (con2 a2)))
+| |- context[@eqitF ?E ?R1 ?R2 ?RR ?b1 ?b2 (?f ?R1 ?R2 ?RR)
+                   (?con ?a) (observe ?t2)] =>
+      change (eqitF RR b1 b2 (f R1 R2 RR)
+                    (con a) (observe t2))
+      with (eqit_mon b1 b2 f R1 R2 RR
+                    (go (con a)) t2)
+| |- context[@eqitF ?E ?R1 ?R2 ?RR ?b1 ?b2 (?f ?R1 ?R2 ?RR)
+                   (observe ?t1) (?con ?a)] =>
+      change (eqitF RR b1 b2 (f R1 R2 RR)
+                    (observe t1) (con a))
+      with (eqit_mon b1 b2 f R1 R2 RR
+                    t1 (go (con a)))
+end.
+
+(* A trick to make [to_mon] work under [forall]. *)
+Ltac to_mon := 
+let guard := fresh "guard" in   
+assert (guard : True) by constructor; 
+          intros; 
+          to_mon_core; 
+          revert_until guard; 
+          clear guard. 
+
+Ltac to_mon_in h :=
+  cbn in h; match type of h with
+| context[@eqitF ?E ?R1 ?R2 ?RR ?b1 ?b2 (?f ?R1 ?R2 ?RR)
+                   (observe ?t1) (observe ?t2)] =>
+      change (eqitF RR b1 b2 (f R1 R2 RR)
+                    (observe t1) (observe t2))
+      with (eqit_mon b1 b2 f R1 R2 RR t1 t2) in h 
+| context[@eqitF ?E ?R1 ?R2 ?RR ?b1 ?b2 (?f ?R1 ?R2 ?RR)
+                   (?con1 ?a1) (?con2 ?a2)] =>
+      change (eqitF RR b1 b2 (f R1 R2 RR)
+                    (con1 a1) (con2 a2))
+      with (eqit_mon b1 b2 f R1 R2 RR
+                    (go (con1 a1)) (go (con2 a2))) in h
+| context[@eqitF ?E ?R1 ?R2 ?RR ?b1 ?b2 (?f ?R1 ?R2 ?RR)
+                   (?con ?a) (observe ?t2)] =>
+      change (eqitF RR b1 b2 (f R1 R2 RR)
+                    (con a) (observe t2))
+      with (eqit_mon b1 b2 f R1 R2 RR
+                    (go (con a)) t2) in h
+| context[@eqitF ?E ?R1 ?R2 ?RR ?b1 ?b2 (?f ?R1 ?R2 ?RR)
+                   (observe ?t1) (?con ?a)] =>
+      change (eqitF RR b1 b2 (f R1 R2 RR)
+                    (observe t1) (con a))
+      with (eqit_mon b1 b2 f R1 R2 RR
+                    t1 (go (con a))) in h
+end.
+
+(** --- Orchestration via the [Utils.v] generics. --- *)
+
+Tactic Notation "icbn" "in" ident(h) := icbn_in h.
+#[local] Tactic Notation "icbn" "in" "*" := cbn [eqit_mon body eqit_] in *.
+
+Tactic Notation "refold" "in" ident(h) := refold_in h.
+Tactic Notation "to_mon" "in" ident(h) := to_mon_in h.
+Tactic Notation "iunfold" "in" ident(h) := iunfold_in h.
+Tactic Notation "iunfold" "in" "*" := iunfold_all.
+
+#[global] Ltac step := 
+(match goal with 
+| |- context[elem _] => idtac 
+| |- _ => 
+repeat red end)
+; ITree.Basics.Utils.step; icbn; try refold.
+
+
+(* Tactic Notation "step" "in" ident(h) :=
+iunfold in h; step in h; icbn in h; try refold_in h. *)
+
+Tactic Notation "step" "in" ident(h) :=
+  repeat red in h; step in h;
+  match type of h with
+  | context [@body _] => repeat red in h
+  | _ => idtac
+  end; try refold in h. 
+
+Tactic Notation "unstep" := iunfold; try to_mon; unstep; try refold.
+Tactic Notation "unstep" "in" ident(h) :=
+  iunfold_in h; try to_mon_in h; unstep_in h; try refold_in h.
+
+Ltac iunfold_coind :=
+  first [ intros ?; iunfold_coind; revert_last | iunfold ].
+
+Tactic Notation "coinduction"
+  simple_intropattern(c) simple_intropattern(CIH) :=
+  repeat red; coinduction c CIH.
+
+Tactic Notation "coinduction" :=
+  let c := fresh "c" in let CIH := fresh "CIH" in coinduction c CIH.
+
+
+Tactic Notation "icoinduction"
+    simple_intropattern(R) simple_intropattern(H) :=
+    coinduction R H; icbn.
+
+
+
+
+(* step -> inversion; common pattern for eutt Hyps *)
+Ltac sinv H := repeat red in H; step in H; inv H.
+
+
+Ltac simpobs_subst := step; simpobs; unstep. 
+
+Ltac apply_foralls :=
+  repeat match goal with
+  | w : ?A, H : forall _ : ?A, _ |- _ => apply (H w)
+  end.
+
+(* [solve_eqitF] tries to solve a goal with a variant of [eqitF] by
+   simplifiying, rewriting, and trying to apply assumptions. *)
+
+Ltac solve_eqitF := 
+  (* reduce to 'observe' form by stripping constructors and unfolding *)
+  iunfold; icbn in *; try econstructor; 
+  (* replace 'observe' with actual constructor values *)
+  simpobs; 
+  (* finish off *)
+  try econstructor; intros; eauto with itree. 
+
+(* [taul] and [taur] peel off a tau from either side when the CHECK flag for
+   that side is set. Their primary purpose is to make proofs more readable. 
+   [taus] is simply the [EqTau] constructor, and serves the same purpose. 
+   *)
+
+Ltac taul := apply EqTauL; [auto|].
+Ltac taur := apply EqTauR; [auto|]. 
+Ltac taus := apply EqTau. 
+
+(* inf_closed automation *)
+Ltac inf_closed_forall_auto := 
+  repeat (apply inf_closed_all; intro). 
+
+Ltac inf_closed_impl_auto := 
+  repeat (apply inf_closed_impl; [intros!; apply_leq; firstorder|]). 
+
+Ltac inf_closed_final_auto := 
+solve [repeat intro; try solve [firstorder]; try apply_leq ; firstorder]. 
+
+Ltac inf_closed_auto := 
+repeat (inf_closed_forall_auto || inf_closed_impl_auto || inf_closed_final_auto). 
+
+Ltac clear_old_chain := match goal with | c : ?T |- forall _ : ?T, _ 
+ => clear c; intro c end. 
+
+Ltac tower_induction := apply tower; [inf_closed_auto|clear_old_chain].
+Tactic Notation "tower" "induction" := tower_induction. 
+
+
+Module step_notation_tests. 
+  #[local] Parameter E : Type -> Type.
+  #[local] Parameter R1 R2 : Type.
+  #[local] Parameter RR : R1 -> R2 -> Prop.
+  #[local] Parameter t u : itree E R1.
+  #[local] Parameter v w : itree E R2.
+  #[local] Parameter eqc : (Chain (@eqit_mon E false false)).
+  #[local] Parameter (EQ1 : t ≅ u).
+  #[local] Parameter (EQUIV1 : t ≈ u).
+  #[local] Parameter (EQ2 : v ≅ w).
+  #[local] Parameter (EQUIV2 : v ≈ w).
+  #[local] Parameter (GT : v ≳ w).
+  #[local] Parameter (GT2 : w ≳ v).
+
+Goal eutt RR u v.
+    (* already in the gfp <-> b gfp loop *)
+    step. unstep.
+    step.
+    Fail step. 
+    unstep. 
+    Fail unstep.  
+    assert (eqitF eq false false (elem eqc _ _ eq) (observe v) (observe w)).
+    step.
+    (* now in the loop *)
+    step. unstep. Fail unstep. step. Fail step. now (unstep; apply EQ2). 
+    assert ((elem eqc _ _ eq) v w).
+    step. step. 
+    (* now in the loop *)
+    step. unstep. Fail unstep. step. Fail step. now (unstep; apply EQ2). 
+    to_mon in H.   
+Abort. 
+
+End step_notation_tests. 
+
+Lemma eqitF_inv_VisF_r {E R1 R2} (RR : R1 -> R2 -> Prop) {b1 b2 sim}
+  t1 X2 (e2 : E X2) (k2 : X2 -> _) :
+  eqitF RR b1 b2 sim t1 (VisF e2 k2) ->
+  (exists k1, t1 = VisF e2 k1 /\ forall v, sim (k1 v) (k2 v)) \/
+    (b1 /\ exists t1', t1 = TauF t1' /\ eqitF RR b1 b2 sim (observe t1') (VisF e2 k2)).
+Proof.
+  refine (fun H =>
+            match H in eqitF _ _ _ _ _ t2 return
+                  match t2 return Prop with
+                  | VisF e2 k2 => _
+                  | _ => True
+                  end
+            with
+            | EqVis _ _ _ _ _ _ _ _ => _
+            | _ => _
+            end); try exact I.
+  - left; eauto.
+  - destruct i0; eauto.
+Qed.
+
+Lemma eqitF_inv_VisF_l {E R1 R2} (RR : R1 -> R2 -> Prop) {b1 b2 sim}
+    t2 X2 (e1 : E X2) (k1 : X2 -> _)
+  : eqitF RR b1 b2 sim (VisF e1 k1) t2 ->
+    (exists k2, t2 = VisF e1 k2 /\ forall v, sim (k1 v) (k2 v)) \/
+    (b2 /\ exists t2', t2 = TauF t2' /\ eqitF RR b1 b2 sim (VisF e1 k1)(observe t2')).
 Proof.
   refine (fun H =>
-    match H in eqitF _ _ _ _ _ _ t2 return
-      match t2 return Prop with
-      | VisF e2 k2 => _
+    match H in eqitF _ _ _ _ t1 _ return
+      match t1 return Prop with
+      | VisF e1 k1 => _
       | _ => True
       end
     with
-    | EqVis _ _ _ _ _ _ _ _ _ => _
+    | EqVis _ _ _ _ _ _ _ _ => _
     | _ => _
     end); try exact I.
   - left; eauto.
-  - destruct i0; eauto.
+  - destruct i; eauto.
 Qed.
 
-Lemma eqitF_inv_VisF_weak {E R1 R2} (RR : R1 -> R2 -> Prop) {b1 b2 vclo sim}
+Lemma eqitF_inv_VisF_weak {E R1 R2} (RR : R1 -> R2 -> Prop) {b1 b2 sim}
     X1 (e1 : E X1) (k1 : X1 -> _) X2 (e2 : E X2) (k2 : X2 -> _)
-  : eqitF RR b1 b2 vclo sim (VisF e1 k1) (VisF e2 k2) ->
-    exists p : X1 = X2, eqeq E p e1 e2 /\ pweqeq (vclo sim) p k1 k2.
-Proof.
+  : eqitF RR b1 b2 sim (VisF e1 k1) (VisF e2 k2) ->
+    exists p : X1 = X2, eqeq E p e1 e2 /\ pweqeq sim p k1 k2.
+Proof. 
   refine (fun H =>
-    match H in eqitF _ _ _ _ _ t1 t2 return
+    match H in eqitF _ _ _ _ t1 t2 return
       match t1, t2 return Prop with
       | VisF e1 k1, VisF e2 k2 => _
       | _, _ => True
       end with
-    | EqVis _ _ _ _ _ _ _ _ _ => _
+    | EqVis _ _ _ _ _ _ _ _ => _
     | _ => _
     end); try exact I.
   - exists eq_refl; cbn; eauto.
   - destruct i; exact I.
 Qed.
 
-Lemma eqitF_inv_VisF {E R1 R2} (RR : R1 -> R2 -> Prop) {b1 b2 vclo sim}
+Lemma eqitF_inv_VisF {E R1 R2} (RR : R1 -> R2 -> Prop) {b1 b2 sim}
     X (e : E X) (k1 : X -> _) (k2 : X -> _)
-  : eqitF RR b1 b2 vclo sim (VisF e k1) (VisF e k2) ->
-    forall x, vclo sim (k1 x) (k2 x).
+  : eqitF RR b1 b2 sim (VisF e k1) (VisF e k2) ->
+    forall x, sim (k1 x) (k2 x).
 Proof.
   intros H. dependent destruction H. assumption.
 Qed.
 
-Lemma eqitF_VisF_gen {E R1 R2} {RR : R1 -> R2 -> Prop} {b1 b2 vclo sim}
+Lemma eqitF_VisF_gen {E R1 R2} {RR : R1 -> R2 -> Prop} {b1 b2 sim}
     {X1 X2} (p : X1 = X2) (e1 : E X1) (k1 : X1 -> _) (e2 : E X2) (k2 : X2 -> _)
-  : eqeq E p e1 e2 -> pweqeq (vclo sim) p k1 k2 ->
-    eqitF RR b1 b2 vclo sim (VisF e1 k1) (VisF e2 k2).
+  : eqeq E p e1 e2 -> pweqeq sim p k1 k2 ->
+    eqitF RR b1 b2 sim (VisF e1 k1) (VisF e2 k2).
 Proof.
   destruct p; intros <-; cbn; constructor; auto.
 Qed.
 
-Ltac unfold_eqit :=
-  (try match goal with [|- eqit_ _ _ _ _ _ _ _ ] => red end);
-  (repeat match goal with [H: eqit_ _ _ _ _ _ _ _ |- _ ] => red in H end).
-
-Lemma fold_eqitF:
-  forall {E R1 R2} (RR: R1 -> R2 -> Prop) b1 b2 (t1 : itree E R1) (t2 : itree E R2) ot1 ot2,
-    eqitF RR b1 b2 id (upaco2 (eqit_ RR b1 b2 id) bot2) ot1 ot2 ->
-    ot1 = observe t1 ->
-    ot2 = observe t2 ->
-    eqit RR b1 b2 t1 t2.
-Proof.
-  intros * eq -> ->; pfold; auto.
-Qed.
-
-(* Tactic to fold eqitF automatically by expanding observe if needed *)
-Tactic Notation "fold_eqitF" hyp(H) :=
-  try punfold H;
-  try red in H;
-  match type of H with
-  | eqitF ?_RR ?_B1 ?_B2 id (upaco2 (eqit_ ?_RR ?_B1 ?_B2 id) bot2) ?_OT1 ?_OT2 =>
-      match _OT1 with
-      | observe _ => idtac
-      | ?_OT1 => change _OT1 with (observe (go _OT1)) in H
-      end;
-      match _OT2 with
-      | observe _ => idtac
-      | ?_OT2 => change _OT2 with (observe (go _OT2)) in H
-      end;
-      eapply fold_eqitF in H; [| eauto | eauto]
-  end.
+Lemma eqitF_flip {E R1 R2} (RR : R1 -> R2 -> Prop) b1 b2 r:
+  flip (eqitF (flip RR) b2 b1 (flip r)) <= @eqitF E R1 R2 RR b1 b2 r.
+Proof.
+  intros!; induction H; eauto with itree.
+Qed.
 
 #[global] Instance eqitF_Proper_R {E : Type -> Type} {R1 R2:Type} :
-  Proper ((@eq_rel R1 R2) ==> eq ==> eq ==> (eq_rel ==> eq_rel) ==> eq_rel ==> eq_rel)
+  Proper ((@eq_rel R1 R2) ==> eq ==> eq ==> eq_rel ==> eq_rel)
     (@eqitF E R1 R2).
 Proof.
-  repeat red.
-  intros. subst. split; unfold subrelationH; intros.
-  - induction H0; auto with itree.
-    econstructor. apply H. assumption.
-    econstructor. apply H3. assumption.
-    econstructor. intros. specialize (REL v). specialize (H2 x3 y3). apply H2 in H3. apply H3. assumption.
-  - induction H0; auto with itree.
-    econstructor. apply H. assumption.
-    econstructor. apply H3. assumption.
-    econstructor. intros. specialize (REL v). specialize (H2 x3 y3). apply H2 in H3. apply H3. assumption.
+  intros!. subst. split; unfold subrelationH, SubRelH_binary; intros.
+  all:
+  induction H0; auto with itree; econstructor; intros;
+  try (now apply H); now apply H2.
 Qed.
 
 #[global] Instance eqitF_Proper_R2 {E : Type -> Type} {R1 R2:Type} :
-  Proper ((@eq_rel R1 R2) ==> eq ==> eq ==> eq ==> eq ==> eq ==> eq ==> iff)
+  Proper ((@eq_rel R1 R2) ==> eq ==> eq ==> eq ==> eq ==> eq ==> iff)
          (@eqitF E R1 R2).
 Proof.
-  repeat red.
-  intros. subst. split; intros.
-  - induction H0; auto with itree.
-    econstructor. apply H. assumption.
-  - induction H0; auto with itree.
-    econstructor. apply H. assumption.
+  intros!. subst. split; intros.
+  all: induction H0; auto with itree;
+       econstructor; now apply H.
 Qed.
 
 #[global] Instance eqit_Proper_R {E : Type -> Type} {R1 R2:Type}
-  : Proper ( (@eq_rel R1 R2) ==> eq ==> eq ==> eq ==> eq ==> iff) (@eqit E R1 R2).
+  : Proper ((@eq_rel R1 R2) ==> eq ==> eq ==> eq ==> eq ==> iff) (@eqit E R1 R2).
 Proof with auto with itree.
-  repeat red.
-  intros. subst.
+  intros RR RR' H b1 b1' Hb1 b2 b2' Hb2 t1 t1' Ht1 t2 t2' Ht2.
+  subst b1' b2' t1' t2'.
   split.
-  -  revert_until y1. pcofix CIH. intros.
-     pstep. punfold H0. red in H0. red.
-     hinduction H0 before CIH; intros...
-     + apply EqRet. apply H. assumption.
-     + apply EqTau. right. apply CIH. pclearbot. pinversion REL...
-     + apply EqVis. intros. red. right. apply CIH.
-       specialize (REL v).
-       red in REL. pclearbot. pinversion REL...
-  -  revert_until y1. pcofix CIH. intros.
-     pstep. punfold H0. red in H0. red.
-     hinduction H0 before CIH; intros...
-     + apply EqRet. apply H. assumption.
-     + apply EqTau. right. apply CIH. pclearbot. pinversion REL...
-     + apply EqVis. intros. red. right. apply CIH.
-       specialize (REL v).
-       red in REL. pclearbot. pinversion REL...
+  - revert t1 t2. icoinduction R CIH. intros t1 t2 H0.
+    step in H0.
+    hinduction H0 before CIH...
+    econstructor; now apply H.
+  - revert t1 t2. icoinduction R CIH. intros t1 t2 H0.
+    step in H0.
+    hinduction H0 before CIH...
+    econstructor; now apply H.
 Qed.
 
-#[global] Instance eutt_Proper_R {E : Type -> Type} {R1 R2:Type}
-  : Proper ( (@eq_rel R1 R2) ==> eq ==> eq ==> iff) (@eutt E R1 R2).
+#[global] Instance eq_itree_Proper_R {E : Type -> Type} {R1 R2:Type}
+  : Proper ( (@eq_rel R1 R2) ==> eq ==> eq ==> iff) (@eq_itree E R1 R2).
 Proof.
-  unfold eutt. repeat red.
-  intros. split; intros; subst.
-  - rewrite <- H. assumption.
-  - rewrite H. assumption.
+  intros ?? H ?? <- ?? <-; unfold eq_itree; now rewrite H.
 Qed.
 
+#[global] Instance euttge_Proper_R {E : Type -> Type} {R1 R2:Type}
+  : Proper ( (@eq_rel R1 R2) ==> eq ==> eq ==> iff) (@euttge E R1 R2).
+Proof.
+  intros ?? H ?? <- ?? <-; unfold euttge; now rewrite H.
+Qed.
 
-Definition flip_clo {A B C} clo r := @flip A B C (clo (@flip B A C r)).
-
-Lemma eqitF_flip {E R1 R2} (RR : R1 -> R2 -> Prop) b1 b2 vclo r:
-  flip (eqitF (flip RR) b2 b1 (flip_clo vclo) (flip r)) <2= @eqitF E R1 R2 RR b1 b2 vclo r.
+#[global] Instance eutt_Proper_R {E : Type -> Type} {R1 R2:Type}
+  : Proper ( (@eq_rel R1 R2) ==> eq ==> eq ==> iff) (@eutt E R1 R2).
 Proof.
-  intros. induction PR; eauto with itree.
+  intros ?? H ?? <- ?? <-; unfold eutt; now rewrite H.
 Qed.
 
+
+(* Note and TODO: if we push [forall R1 R2 RR] below the [gfp],
+   this and monotonicity will hold on chains.
+   Meaning, assuming it can typecheck after the generalization,
+   the following are conjectures:
+   [forall (c : Chain (@eqit_mon E)),
+   `c (flip RR) b2 b1 <= `c RR b1 b2]
+   Though this would require to push b1 and b2 below the gfp
+   as well, which sounds highly silly.
+   Alternatively, it would be restricted to b1 = b2.
+ *)
+
 Lemma eqit_flip {E R1 R2} (RR : R1 -> R2 -> Prop) b1 b2:
   forall (u : itree E R1) (v : itree E R2),
     eqit (flip RR) b2 b1 v u -> eqit RR b1 b2 u v.
 Proof.
-  pcofix self; pstep. intros u v euv. punfold euv.
-  red in euv |- *. induction euv; pclearbot; eauto 7 with paco itree.
+  (* do coinduction. *)
+  icoinduction c CIH. intros u v euv. 
+  (* reduce the hypothesis and conclusion to the right form. *)
+  step in euv.
+  (* do induction and conclude trivially with constructors. *)
+  induction euv; eauto with itree.
 Qed.
 
-Lemma eqit_mon {E R1 R2} RR RR' (b1 b2 b1' b2': bool)
-      (LEb1: b1 -> b1')
-      (LEb2: b2 -> b2')
-      (LERR: RR <2= RR'):
-  @eqit E R1 R2 RR b1 b2 <2= eqit RR' b1' b2'.
+Lemma eutt_flip : forall (E : Type -> Type) (A B : Type) (R : A -> B -> Prop)
+                         (ta : itree E A) (tb : itree E B),
+    eutt R ta tb -> eutt (flip R) tb ta.
 Proof.
-  pcofix self. pstep. intros u v euv. punfold euv.
-  red in euv |- *. induction euv; pclearbot; eauto 7 with paco itree.
+  intros. now apply eqit_flip.  
 Qed.
 
 #[global] Hint Unfold flip : itree.
 
-(* end hide *)
-
-(** A notation of [eq_itree eq]. You can write [≅] using [[\cong]] in
-    tex-mode *)
+(** [eqit] itself is monotone *)
 
-Infix "≅" := (eq_itree eq) (at level 70) : type_scope.
-
-Infix "≈" := (eutt eq) (at level 70) : type_scope.
+Lemma eqit_mono {E R1 R2} RR RR' (b1 b2 b1' b2': bool)
+      (LEb1: b1 -> b1')
+      (LEb2: b2 -> b2')
+      (LERR: RR <= RR'):
+  @eqit E R1 R2 RR b1 b2 <= eqit RR' b1' b2'.
+Proof.
+  intros!. 
+  revert a a0 H. 
+  icoinduction c CIH; intros.  
+  step in H. induction H; eauto with itree.
+  econstructor. now apply LERR.  
+Qed.
 
-Infix "≳" := (euttge eq) (at level 70) : type_scope.
+(** ** Properties of relations *)
 
-(* TODO: Find a way to not clobber the export [type_scope]? *)
+(** Instances stating that we have equivalence relations. *)
 
-Section eqit_closure.
+Section eqit_gen.
 
-Context {E : Type -> Type} {R1 R2 : Type} (RR : R1 -> R2 -> Prop).
+(** *** Properties of relation transformers. *)
 
-(** *** "Up-to" principles for coinduction. *)
+  Context {E : Type -> Type} {R: Type} (RR : R -> R -> Prop).
 
-Inductive eqit_trans_clo b1 b2 b1' b2' (r : itree E R1 -> itree E R2 -> Prop)
-  : itree E R1 -> itree E R2 -> Prop :=
-| eqit_trans_clo_intro t1 t2 t1' t2' RR1 RR2
-      (EQVl: eqit RR1 b1 b1' t1 t1')
-      (EQVr: eqit RR2 b2 b2' t2 t2')
-      (REL: r t1' t2')
-      (LERR1: forall x x' y, RR1 x x' -> RR x' y -> RR x y)
-      (LERR2: forall x y y', RR2 y y' -> RR x y' -> RR x y)
-  : eqit_trans_clo b1 b2 b1' b2' r t1 t2
-.
-Hint Constructors eqit_trans_clo : itree.
+  (** *** Order properties of the respective chains *)
 
-Definition eqitC b1 b2 := eqit_trans_clo b1 b2 false false.
-Hint Unfold eqitC : itree.
+  (** Universal properties of the chains of the respective relations:
+    - all three are reflexive
+    - the chains for [eq_itree] and [eutt] are symmetric
+    - the chain for [eq_itree] is additionally transitive
+Properties of the chains specialize to the relations: the gfp is an element of the chain.
+   *)
+  
+#[global] Instance Reflexive_eqitF b1 b2 (sim : itree E R -> itree E R -> Prop)
+    : Reflexive RR -> Reflexive sim -> Reflexive (eqitF RR b1 b2 sim).
+Proof.
+    red. destruct x; constructor; eauto with itree.
+Qed.
 
-Lemma eqitC_mon b1 b2 r1 r2 t1 t2
-      (IN: eqitC b1 b2 r1 t1 t2)
-      (LE: r1 <2= r2):
-  eqitC b1 b2 r2 t1 t2.
+  (* We of course exclude the asymmetric case *)
+#[global] Instance Symmetric_eqitF b (sim : itree E R -> itree E R -> Prop)
+    : Symmetric RR -> Symmetric sim -> Symmetric (eqitF RR b b sim).
 Proof.
-  destruct IN. econstructor; eauto.
+    red. induction 3; constructor; subst; eauto.
 Qed.
 
-Hint Resolve eqitC_mon : paco.
+  (* Note the strong bisimulation assumption *)
+#[global] Instance Transitive_eqitF (sim : itree E R -> itree E R -> Prop)
+    : Transitive RR -> Transitive sim -> Transitive (eqitF RR false false sim).
+Proof.
+    intros ?? t u v EQ1 EQ2.
+    inv EQ1; try now (inv EQ2; eauto with itree).
+    apply eqitF_inv_VisF_l in EQ2 as [(? & -> & ?) | [abs _]]; [| easy].
+    constructor; eauto.
+Qed. 
 
-Lemma eqitC_wcompat b1 b2 vclo
-      (MON: monotone2 vclo)
-      (CMP: compose (eqitC b1 b2) vclo <3= compose vclo (eqitC b1 b2)):
-  wcompatible2 (@eqit_ E R1 R2 RR b1 b2 vclo) (eqitC b1 b2).
-Proof with eauto with paco itree.
-  econstructor; [ eauto with paco itree | ].
-  intros. destruct PR.
-  punfold EQVl. punfold EQVr. unfold_eqit.
-  hinduction REL before r; intros; clear t1' t2'.
-  - remember (RetF r1) as x.
-    hinduction EQVl before r; intros; subst; try inv Heqx; [ | eauto with itree ].
-    remember (RetF r3) as y.
-    hinduction EQVr before r; intros; subst; try inv Heqy...
-  - remember (TauF m1) as x.
-    hinduction EQVl before r; intros; subst; try inv Heqx; try inv CHECK; [ | eauto with itree ].
-    remember (TauF m3) as y.
-    hinduction EQVr before r; intros; subst; try inv Heqy; try inv CHECK; [ | eauto with itree ].
-    pclearbot. econstructor. gclo.
-    econstructor; eauto with paco.
-  - remember (VisF e k1) as x.
-    hinduction EQVl before r; intros; try discriminate Heqx; [ inv_Vis | eauto with itree ].
-    remember (VisF e k3) as y.
-    hinduction EQVr before r; intros; try discriminate Heqy; [ inv_Vis | eauto with itree ].
-    econstructor. intros. pclearbot.
-    eapply MON.
-    + apply CMP. econstructor...
-    + intros. apply gpaco2_clo, PR.
-  - remember (TauF t1) as x.
-    hinduction EQVl before r; intros; subst; try inv Heqx; try inv CHECK; [ | eauto with itree ].
-    pclearbot. punfold REL...
-  - remember (TauF t2) as y.
-    hinduction EQVr before r; intros; subst; try inv Heqy; try inv CHECK; [ | eauto with itree ].
-    pclearbot. punfold REL...
-Qed.
+(* Prove Reflexive/Symmetric for eqit first (by coinduction),
+    then derive for elem via gfp_chain. *)
 
-Hint Resolve eqitC_wcompat : paco.
+#[global] Instance Reflexive_eqit b1 b2 : Reflexive RR -> Reflexive (@eqit E _ _ RR b1 b2).
+Proof.
+  red; intros.
+  revert x. icoinduction c CIH. intro. 
+  now repeat apply Reflexive_eqitF.
+Qed.
 
-Lemma eqit_idclo_compat b1 b2: compose (eqitC b1 b2) id <3= compose id (eqitC b1 b2).
+#[global] Instance Symmetric_eqit b : Symmetric RR -> Symmetric (@eqit E _ _ RR b b).
 Proof.
-  intros. apply PR.
+  intros Hsym x y Hxy.
+  apply eqit_flip.
+  eapply eqit_mono; [auto | auto | | exact Hxy]; auto. 
 Qed.
-Hint Resolve eqit_idclo_compat : paco.
 
-Lemma eqitC_dist b1 b2:
-  forall r1 r2, eqitC b1 b2 (r1 \2/ r2) <2= (eqitC b1 b2 r1 \2/ eqitC b1 b2 r2).
+#[global] Instance Reflexive_elem (b1 b2: bool) (HR : Reflexive RR)
+  {c: Chain (@eqit_mon E b1 b2)}: Reflexive (elem c R R RR).
 Proof.
-  intros. destruct PR. destruct REL; eauto with itree.
+  red; intro x.
+  apply (gfp_chain c).
+  reflexivity.
 Qed.
 
-Hint Resolve eqitC_dist : paco.
+Lemma inf_closed_Symmetric_at :
+  inf_closed (X := forall R1 R2, (R1 -> R2 -> Prop) -> itree E R1 -> itree E R2 -> Prop)
+    (fun x => Symmetric (x R R RR)).
+Proof.
+  intros T HT x y Hxy.
+  intros z Hz. apply HT; auto.
+Qed.
 
-Lemma eqit_clo_trans b1 b2 vclo
-      (MON: monotone2 vclo)
-      (CMP: compose (eqitC b1 b2) vclo <3= compose vclo (eqitC b1 b2)):
-  eqit_trans_clo b1 b2 false false <3= gupaco2 (eqit_ RR b1 b2 vclo) (eqitC b1 b2).
+#[global] Instance Symmetric_elem (b: bool) (HS : Symmetric RR)
+  {c: Chain (@eqit_mon E b b)}: Symmetric (elem c R R RR).
 Proof.
-  intros. destruct PR. gclo. econstructor; eauto with paco.
+  revert c. apply (tower inf_closed_Symmetric_at).
+  intros c Hsym. intros!. apply Symmetric_eqitF; auto.
 Qed.
 
-End eqit_closure.
+End eqit_gen.
 
-#[global] Hint Unfold eqitC : itree.
-#[global] Hint Resolve eqitC_mon : paco.
-#[global] Hint Resolve eqitC_wcompat : paco.
-#[global] Hint Resolve eqit_idclo_compat : paco.
-#[global] Hint Resolve eqitC_dist : paco.
-Arguments eqit_clo_trans : clear implicits.
-#[global] Hint Constructors eqit_trans_clo : itree.
 
-(** ** Properties of relations *)
+Section eqit_inv.
 
-(** Instances stating that we have equivalence relations. *)
+  Context {E : Type -> Type} {R1 R2} {RR : R1 -> R2 -> Prop} {b1 b2 : bool}.
+  Context {sim : itree E R1 -> itree E R2 -> Prop}.
+
+  Notation eqit__ t1_ t2_ :=
+    match _observe t1_, _observe t2_ with
+    | RetF r1, RetF r2 => RR r1 r2
+    | VisF e1 k1, VisF e2 k2 =>
+        exists p, eqeq E p e1 e2 /\ pweqeq (eqit RR b1 b2) p k1 k2
+    | RetF _, VisF _ _ | VisF _ _, RetF _ => False
+    | TauF t1, TauF t2 => eqit RR b1 b2 t1 t2
+    | TauF t1, _ =>
+        if b1 then eqit RR b1 b2 t1 t2_
+        else False
+    | _, TauF t2 =>
+        if b2 then eqit RR b1 b2 t1_ t2
+        else False
+    end.
+
+  Lemma eqit_inv_Tau_l t1 t2 :
+    @eqit E R1 R2 RR b1 true (Tau t1) t2 -> eqit RR b1 true t1 t2.
+  Proof.
+    intros * H.
+    step in H.
+    step.   
+    remember (observe (Tau t1)).
+    induction H; inv Heqi.  
+    - step in REL. now taur.
+    - taur. now apply IHeqitF. 
+  Qed. 
+
+  Lemma eqit_inv_Tau_r t1 t2 :
+    @eqit E R1 R2 RR true b2 t1 (Tau t2) -> eqit RR true b2 t1 t2.
+  Proof.
+    intros * H.
+    step in H.
+    step.   
+    remember (observe (Tau t2)).
+    induction H; inv Heqi.  
+    - step in REL. now taul. 
+    - taul. now apply IHeqitF. 
+  Qed. 
+
+  Lemma eqitF_inv_Tau t1 t2 :
+    @eqitF E R1 R2 RR b1 b2 (gfp (eqit_mon b1 b2) R1 R2 RR) (TauF t1) (TauF t2)
+    -> eqitF RR b1 b2 (gfp (eqit_mon b1 b2) R1 R2 RR) (observe t1) (observe t2).
+  Proof.
+    intros.
+    remember (TauF t1) as ot1. 
+    remember (TauF t2) as ot2. 
+    revert t1 t2 Heqot1 Heqot2.
+    induction H; intros t1' t2' Heqot1 Heqot2; try easy; subst.
+    - inv Heqot1; inv Heqot2. now unstep.  
+    - inv H; inv Heqot1; simpobs. 
+      + taul. now step in REL.  
+      + taul. now apply IHeqitF.  
+    - inv H; inv Heqot2; simpobs. 
+      + taur. now step in REL. 
+      + taur. now apply IHeqitF. 
+  Qed. 
+
+  Lemma eqit_inv_Tau t1 t2 :
+    @eqit E R1 R2 RR b1 b2 (Tau t1) (Tau t2) -> eqit RR b1 b2 t1 t2.
+  Proof.
+    intros.
+    step in H; step.
+    now apply eqitF_inv_Tau. 
+  Qed. 
 
-Section eqit_gen.
+  Lemma eqit_inv t1 t2 : eqit RR b1 b2 t1 t2 -> eqit__ t1 t2.
+  Proof.
+    intros H; step in H.
+    genobs t1 ot1; genobs t2 ot2; revert t1 t2 Heqot1 Heqot2; unfold observe, _observe.
+    destruct H; intros * E1 E2; rewrite <- E1, <- E2; cbn; auto.
+    - exists eq_refl; cbn; eauto.
+    - rewrite CHECK in *. destruct ot2.
+      1,3: step; unfold observe, _observe; rewrite <- E2; assumption.
+      1: apply eqit_inv_Tau_r; step; unfold observe, _observe; assumption.
+    - rewrite CHECK in *. destruct ot1.
+      1,3: step; unfold observe, _observe; rewrite <- E1; assumption.
+      1: apply eqit_inv_Tau_l; step; unfold observe, _observe; assumption.
+  Qed.
 
-(** *** Properties of relation transformers. *)
+End eqit_inv.
 
-Context {E : Type -> Type} {R: Type} (RR : R -> R -> Prop).
+Ltac genret r or := remember (RetF r) as or.
+Ltac gentau t ot := remember (TauF t) as ot.
+Ltac genvis e k ot := remember (VisF e k) as ot.
+
+Lemma euttge_tau_r_inv [E R1 R2 RR] (t : itree E R1) (u : itree E R2) :
+  euttge RR t (Tau u) -> exists t', observe t = TauF t'.
+Proof.
+  intros EQ; step in EQ.
+  desobs t ot; eauto; inv EQ; easy.
+Qed.
+
+Lemma euttge_tau_inv {E R1 R2 RR} (t : itree E R1) (u : itree E R2):
+  euttge RR t u  ->
+  forall t' u',
+  observe t = TauF t' ->
+  observe u = TauF u' ->
+  euttge RR t' u'.
+Proof.
+  intros EQ.
+  step in EQ; cbn in EQ.
+  genobs t ot; genobs u ou.
+  revert t u Heqot Heqou.
+  induction EQ; intros; try easy.
+  - inv H; inv H0. 
+  - inv H; simpobs.
+    edestruct euttge_tau_r_inv; [step; eauto |].
+    step.
+    simpobs.
+    taul.
+    unstep.
+    eapply IHEQ; eauto.
+Qed.
+
+#[global] Instance euttge_proper_euttC {E R1 R2}
+  (RR : R1 -> R2 -> Prop) (c : euttC):
+  Proper (euttge (E := E) eq ==> euttge eq ==> flip impl) (elem c _ _ RR).
+Proof with eauto with itree.
+  unfold Proper, respectful, flip, impl.
+  tower induction.
+  intros IH x x' EQx y y' EQy; step in EQx; step in EQy.
+    intros EQ. icbn in *. 
+    genobs x' ox'; genobs y' oy'.
+    (* [hinduction] is not sufficient here, because [move] is unable to pass
+         through [ox] to reach [x] *)
+    revert x x' y y' Heqox' Heqoy' EQx EQy.
+    induction EQ; intros.
+    + clear x' y' Heqox' Heqoy'.
+      genobs x ox.
+      genret r1 or1.
+      revert x Heqox.
+      hinduction EQx before ox; try easy.
+      * intros; subst; inv Heqor1. clear x Heqox.
+        genobs y oy; genret r2 or2.
+        revert y Heqoy.
+        hinduction EQy before oy; try easy.
+        subst; intros [=<-] ??...
+        now intros; taur; eapply IHEQy.
+      * intros; subst; taul; eapply IHEQx...
+    + clear x' y' Heqox' Heqoy'.
+      genobs x ox.
+      gentau m1 om1.
+      revert x Heqox.
+      hinduction EQx before ox; try easy.
+      * intros [=<-] ? ??.
+        clear x Heqox.
+        genobs y oy; gentau m2 om2.
+        revert y Heqoy.
+        hinduction EQy before oy; try easy.
+        intros [=<-] ??...
+        intros.
+        taur.
+        now eapply IHEQy.
+      * intros; subst; taul; eapply IHEQx...
+    + clear x' y' Heqox' Heqoy'.
+      genobs x ox.
+      genvis e k1 ot1.
+      revert x Heqox.
+      hinduction EQx before ox; try easy.
+      * intros.
+        apply eq_inv_VisF_weak in Heqot1 as (-> & ? & ?); cbn in *; subst.
+        clear x Heqox.
+        genobs y oy; genvis e k2 ot2.
+        revert y Heqoy.
+        hinduction EQy before oy; try easy.
+        intros; apply eq_inv_VisF_weak in Heqot2 as (-> & ? & ?); cbn in *; subst; eauto with itree.
+        intros.
+        taur.
+        now eapply IHEQy.
+      * intros; subst; taul; eapply IHEQx...
+    + edestruct euttge_tau_r_inv; [step; eauto |].
+      simpobs.
+      taul.
+      eapply IHEQ; eauto.
+      assert (euttge eq (Tau x0) (Tau t1)) by (now step).
+      unstep; eapply euttge_tau_inv; eauto.
+    + edestruct euttge_tau_r_inv; [step; eauto |].
+      simpobs.
+      taur.
+      eapply IHEQ; eauto.
+      assert (euttge eq (Tau x0) (Tau t2)) by (now step).
+      unstep; eapply euttge_tau_inv; eauto.
+Qed. 
+
+
+
+(* here chain_b lifts b to elements of the chain... *)
+#[global] Instance euttge_proper_euttC_mon {E R1 R2}
+  (RR : R1 -> R2 -> Prop) (c : euttC):
+  Proper ((euttge (E := E) eq) ==> (euttge eq) ==> flip impl) 
+         (eqit_mon true true (elem c) R1 R2 RR).
+Proof.
+  eapply euttge_proper_euttC with (c := chain_b c); eauto.  
+Qed. 
+
+(* ... and chain_gfp lifts the gfp. *)
+#[global] Instance euttge_proper_eutt  {E R1 R2}
+  (RR : R1 -> R2 -> Prop) (c : Chain (@eqit_mon E true true)):
+  Proper ((euttge (E := E) eq) ==> (euttge eq) ==> flip impl)  
+         (eutt RR). 
+Proof.
+  eapply euttge_proper_euttC with (c := (chain_gfp (eqit_mon true true))); eauto.  
+Qed. 
+
+Lemma eq_subH_euttge {E R1 R2} (RR : R1 -> R2 -> Prop):
+  subrelationH (@eq_itree E _ _ RR) (euttge RR).
+Proof. now apply eqit_mono. Qed.
+
+#[global] Instance eq_sub_euttge {E R} (RR : R -> R -> Prop):
+  subrelation (@eq_itree E _ _ RR) (euttge RR).
+Proof. now apply eqit_mono. Qed.
 
-#[global] Instance Reflexive_eqitF b1 b2 (sim : itree E R -> itree E R -> Prop)
-: Reflexive RR -> Reflexive sim -> Reflexive (eqitF RR b1 b2 id sim).
-Proof.
-  red. destruct x; constructor; eauto with itree.
+Lemma euttge_subH_eutt {E R1 R2} (RR : R1 -> R2 -> Prop):
+  subrelationH (@euttge E _ _ RR) (eutt RR).
+Proof. now eapply eqit_mono. Qed.
+
+#[global] Instance euttge_sub_eutt {E R} (RR : R -> R -> Prop):
+  subrelation (@euttge E _ _ RR) (eutt RR).
+Proof. now apply eqit_mono. Qed.
+
+Lemma eq_subH_eutt {E R1 R2} (RR : R1 -> R2 -> Prop):
+  subrelationH (@eq_itree E _ _ RR) (eutt RR).
+Proof. now apply eqit_mono. Qed.
+
+#[global] Instance eq_sub_eutt {E R} (RR : R -> R -> Prop):
+  subrelation (@eq_itree E _ _ RR) (eutt RR).
+Proof. now apply eqit_mono. Qed.
+
+#[global] Instance eq_proper_euttC {E R1 R2}
+  (RR : R1 -> R2 -> Prop) (c : euttC):
+  Proper (eq_itree (E := E) eq ==> eq_itree eq ==> iff) (elem c _ _ RR).
+Proof. 
+  split; intro. 
+  1: symmetry in H; symmetry in H0. 
+  all: 
+  apply eq_sub_euttge with (RR := eq) in H;
+  apply eq_sub_euttge with (RR := eq) in H0;
+  eapply euttge_proper_euttC; eauto.
+Qed.
+
+#[global] Instance eq_proper_eqit {E R1 R2 b1 b2}
+  (RR : R1 -> R2 -> Prop):
+  Proper (eq_itree (E := E) eq ==> eq_itree eq ==> iff) (eqit RR b1 b2). 
+Proof with eauto with itree. 
+  split; intros; 
+  revert_until RR; 
+  icoinduction c CIH; intros; 
+  step in H0; step in H1; step in H; icbn in *.
+  all:
+  hinduction H1 before RR; intros.
+   (* ret and taus cases *)
+  1-2, 6-7: inv H; inv H0; simpobs; eauto with itree. 
+  (* vis *)
+  1,4:
+  genvis e k1 ok1; inv H; simpobs;
+  genvis e k2 ok2; inv H0; simpobs;
+  do 2 inv_Vis; constructor; intros;
+  specialize (REL1 v);
+  specialize (REL0 v);
+  eapply CIH; eauto. 
+  (* inductive steps *)
+  1,3: 
+  inv H; simpobs; taul; eapply IHeqitF; eauto; now step in REL.
+  1-2: 
+  inv H0; simpobs; taur; eapply IHeqitF; eauto; now step in REL.
+Qed.
+
+(* [euttge_proper_euttgeC] with [euttge eq] on BOTH arguments is FALSE.
+   Counterexample: c = chain_gfp (eqit_mon eq true false) so ̇c = euttge eq.
+   Take x = x' = Ret tt, y = Tau (Ret tt), y' = Ret tt.
+   Then euttge eq (Ret tt) (Ret tt) ✓, euttge eq (Tau (Ret tt)) (Ret tt) ✓ (EqTauL),
+   and ̇c (Ret tt) (Ret tt) = euttge eq (Ret tt) (Ret tt) ✓,
+   but ̇c (Ret tt) (Tau (Ret tt)) = euttge eq (Ret tt) (Tau (Ret tt)) is FALSE
+   because b2=false means the right side cannot skip taus. *)
+Lemma not_euttge_proper_euttgeC :
+~ (forall E R1 R2 (RR : R1 -> R2 -> Prop) (c : euttgeC),
+  Proper (euttge (E := E) eq ==> euttge eq ==> flip impl) (elem c _ _ RR)).
+  unfold Proper, respectful, flip, impl. 
+  intro. 
+assert (Hfalse : euttge (E := fun _ => False) (R1 := unit) (R2 := unit) eq
+                    (Ret tt) (Tau (Ret tt))).
+  { eapply H with (x := Ret tt) (y := Ret tt).
+  (* ^ this works because the canonical chain structure uses chain_gfp
+     to coerce things into the right shape. *)
+    - reflexivity.
+    - step. taul. reflexivity.
+    - reflexivity. }
+  step in Hfalse. inv Hfalse. 
+Qed.  
+
+Lemma euttge_proper_flip_euttgeC {E R1 R2} 
+  (RR : R1 -> R2 -> Prop) (c : euttgeC) :
+  Proper (euttge (E := E) eq ==> flip (euttge eq) ==> flip impl) (elem c _ _ RR).
+  (* FALSE: *)
+  (*   
+   τ 1  [≳⟨RR⟩]  τ 1
+   ≳             ≳
+   1   [≳⟨RR⟩]   τ 1 
+  *)
+Abort. 
+
+#[global] Instance euttge_eq_proper_euttgeC {E R1 R2}
+  (RR : R1 -> R2 -> Prop) (c : euttgeC):
+  Proper (euttge (E := E) eq ==> eq_itree eq ==> flip impl) (elem c _ _ RR).
+Proof with eauto with itree.
+  unfold Proper, respectful, flip, impl.
+  tower induction.
+  intros IH x x' EQx y y' EQy; step in EQx; step in EQy.
+    intros EQ. icbn in *. 
+    genobs x' ox'; genobs y' oy'.
+    revert x x' y y' Heqox' Heqoy' EQx EQy.
+    induction EQ; intros.
+    + clear x' y' Heqox' Heqoy'.
+      genobs x ox.
+      genret r1 or1.
+      revert x Heqox.
+      hinduction EQx before ox; try easy.
+      * intros; subst; inv Heqor1. clear x Heqox.
+        genobs y oy; genret r2 or2.
+        revert y Heqoy.
+        (* EQy is eq_itree eq (b1=b2=false): EqTauL/EqTauR cases dismissed by [try easy] *)
+        hinduction EQy before oy; try easy.
+        subst; intros [=<-] ??...
+      * intros; subst; taul; eapply IHEQx...
+    + clear x' y' Heqox' Heqoy'.
+      genobs x ox.
+      gentau m1 om1.
+      revert x Heqox.
+      hinduction EQx before ox; try easy.
+      * intros [=<-] ? ??.
+        clear x Heqox.
+        genobs y oy; gentau m2 om2.
+        revert y Heqoy.
+        hinduction EQy before oy; try easy.
+        intros [=<-] ??...
+      * intros; subst; taul; eapply IHEQx...
+    + clear x' y' Heqox' Heqoy'.
+      genobs x ox.
+      genvis e k1 ot1.
+      revert x Heqox.
+      hinduction EQx before ox; try easy.
+      * intros.
+        apply eq_inv_VisF_weak in Heqot1 as (-> & ? & ?); cbn in *; subst.
+        clear x Heqox.
+        genobs y oy; genvis e k2 ot2.
+        revert y Heqoy.
+        hinduction EQy before oy; try easy.
+        intros; apply eq_inv_VisF_weak in Heqot2 as (-> & ? & ?); cbn in *; subst; eauto with itree.
+      * intros; subst; taul; eapply IHEQx...
+    + edestruct euttge_tau_r_inv; [step; eauto |].
+      simpobs.
+      taul.
+      eapply IHEQ; eauto.
+      assert (euttge eq (Tau x0) (Tau t1)) by (now step).
+      unstep; eapply euttge_tau_inv; eauto.
+    + easy. 
+    (* no EqTauR block: euttgeC has b2=false *)
+Qed.
+
+#[global] Instance eq_proper_euttgeC {E R1 R2}
+  (RR : R1 -> R2 -> Prop) (c : euttgeC):
+  Proper (eq_itree (E := E) eq ==> eq_itree eq ==> iff) (elem c _ _ RR).
+Proof.
+  split; intro.
+  - (* forward: t1 ≅ t2, s1 ≅ s2, ̇c t1 s1 → ̇c t2 s2:
+       need t2 ≳ t1 (reverse) and s2 ≅ s1 (reverse) *)
+    symmetry in H; apply eq_sub_euttge with (RR := eq) in H.
+    symmetry in H0.
+    eapply euttge_eq_proper_euttgeC; eauto.
+  - (* backward: t1 ≅ t2, s1 ≅ s2, ̇c t2 s2 → ̇c t1 s1:
+       need t1 ≳ t2 and s1 ≅ s2 (direct) *)
+    apply eq_sub_euttge with (RR := eq) in H.
+    eapply euttge_eq_proper_euttgeC; eauto.
+Qed.
+
+
+#[global] Instance eq_proper_eq_itreeC {E R1 R2}
+  (RR : R1 -> R2 -> Prop) (c : eq_itreeC):
+  Proper (eq_itree (E := E) eq ==> eq_itree eq ==> iff) (elem c _ _ RR).
+Proof. 
+  split; revert_until c; tower induction; intros!;
+  step in H0; step in H1; icbn in *.
+  (* this proof is largely uninteresting and is just diagram chase. *)
+  all: 
+  inv H2; simpobs.
+  all: 
+  try genvis e k1 ok1; inv H0; simpobs;
+  try genvis e k2 ok2; inv H1; simpobs. 
+  all: try do 2 inv_Vis; constructor; intros; try eapply H; eauto.
+  all: inv H1; inv H0.  
+  all: 
+  eapply H; try eapply REL0; try eapply REL1; eauto.   
 Qed.
 
-#[global] Instance Symmetric_eqitF b (sim : itree E R -> itree E R -> Prop)
-: Symmetric RR -> Symmetric sim -> Symmetric (eqitF RR b b id sim).
+
+(** *** Transitivity properties *)
+
+Inductive rcompose {R1 R2 R3} (RR1: R1->R2->Prop) (RR2: R2->R3->Prop) (r1: R1) (r3: R3) : Prop :=
+| rcompose_intro r2 (REL1: RR1 r1 r2) (REL2: RR2 r2 r3)
+.
+#[global] Hint Constructors rcompose : itree.
+
+Lemma trans_rcompose {R} RR (TRANS: Transitive RR):
+  forall x y : R, rcompose RR RR x y -> RR x y.
 Proof.
-  red. induction 3; constructor; subst; eauto.
-  intros. apply H0. apply (REL v).
+  intros. destruct H; eauto.
 Qed.
 
-#[global] Instance Reflexive_eqit_ b1 b2 (sim : itree E R -> itree E R -> Prop)
-: Reflexive RR -> Reflexive sim -> Reflexive (eqit_ RR b1 b2 id sim).
-Proof. repeat red. intros. reflexivity. Qed.
+(* Transitivity of eqit *)
+Lemma eqit_trans {E R1 R2 R3} (RR1: R1->R2->Prop) (RR2: R2->R3->Prop) b1 b2 t1 t2 t3
+      (INL: eqit RR1 b1 b2 t1 t2)
+      (INR: eqit RR2 b1 b2 t2 t3):
+  @eqit E _ _ (rcompose RR1 RR2) b1 b2 t1 t3.
+Proof.
+  unfold eqit. revert_until b2.  
+  (* we'll need the coinductive reasoning later: elements of the chain 
+  are transitive w.r.t. eqit. *)
+  icoinduction c CIH. intros. 
+  step in INL. step in INR.
+  (* we begin with induction on t1 ~ t2. 
+  in each case, we perform induction on t2 ~ t3.  *)
+  hinduction INL before CIH; intros; subst. clear t1 t2.
+  (* Ret, straightforward *)
+  - genret r2 ot.
+    hinduction INR before CIH; intros; inv Heqot; eauto with itree.
+  - genobs t3 ot3. 
+    (* need something more: t3 is either a τ node, or it isn't. *)
+    assert (DEC: (exists m3, ot3 = TauF m3) \/ (forall m3, ot3 <> TauF m3)).
+    { destruct ot3; eauto; right; red; intros; easy. }
+    destruct DEC as [[m3 ?] | EQ].
+    (* τ - τ case: strip both. *)
+    + subst; simpobs. 
+      econstructor.
+      eapply CIH; eauto.
+      apply eqit_inv_Tau.
+      now step.    
+    (* τ - ̸τ : we do further case analysis. *)
+    + inv INR; try (exfalso; eapply EQ; eauto; fail).
+      taul. 
+      step in REL.
+      hinduction REL0 before CIH; intros; try (exfalso; eapply EQ; eauto; fail).
+      (* now we can handle each subcase with another layer of induction *)
+      * remember (RetF r1) as ot.
+        hinduction REL0 before CIH; intros; inv Heqot; eauto with itree.
+      * remember (VisF e k1) as ot.
+        hinduction REL0 before CIH; intros; try discriminate; [ inv_Vis | eauto with itree ].
+        econstructor. intros.
+        apply (CIH _ _ _ (REL v) (REL0 v)). 
+      * eapply IHREL0; eauto.
+        destruct b1; inv CHECK0.
+        unstep. apply eqit_inv_Tau_r. now step. 
+  - remember (VisF e k2) as ot.
+    hinduction INR before CIH; intros; try discriminate; [ inv_Vis | eauto with itree ].
+    econstructor. intros.
+    apply (CIH _ _ _ (REL0 v) (REL v)). 
+  - eauto with itree.
+  - gentau t0 ot.
+    genobs t3 ot3. 
+    hinduction INR before CIH; intros; try inversion Heqot; subst.
+    + eapply (IHINL (Tau m2)).
+      step in REL. eauto with itree.
+    + now eapply IHINL.
+    + taur. eapply IHINR; eauto. 
+Qed.
 
-#[global] Instance Symmetric_eqit_ b (sim : itree E R -> itree E R -> Prop)
-: Symmetric RR -> Symmetric sim -> Symmetric (eqit_ RR b b id sim).
-Proof. repeat red; symmetry; auto. Qed.
+Arguments eqit_trans {E R1 R2 R3} [RR1 RR2 b1 b2 t1 t2 t3].
+(* We can now package the instances for the top level relations:
+   two equivalences and a preorder as expected.
+ *)
+#[global] Instance Transitive_eqit {E : Type -> Type} {R: Type} (RR : R -> R -> Prop) (b1 b2: bool):
+  Transitive RR -> Transitive (@eqit E _ _ RR b1 b2).
+Proof.
+  red; intros. assert (TRANS := trans_rcompose RR). 
+  eapply eqit_mono, eqit_trans; eauto.
+  intros!. now apply TRANS.
+Qed.
 
-(** *** [eqit] is an equivalence relation *)
+#[global] Instance Transitive_eqit_eq {E : Type -> Type} {R: Type} (b1 b2: bool):
+  Transitive (@eqit E R R eq b1 b2).
+Proof.
+  apply Transitive_eqit. intros!; subst; eauto.
+Qed.
 
-#[global] Instance Reflexive_eqit_gen b1 b2 (r rg: itree E R -> itree E R -> Prop) :
-  Reflexive RR -> Reflexive (gpaco2 (eqit_ RR b1 b2 id) (eqitC RR b1 b2) r rg).
+#[global] Instance Equivalence_eqit {E : Type -> Type} {R: Type} (RR : R -> R -> Prop) (b: bool):
+  Equivalence RR -> Equivalence (@eqit E R R RR b b).
 Proof.
-  pcofix CIH. gstep; intros.
-  repeat red. destruct (observe x); eauto with paco itree.
+  constructor; try typeclasses eauto.
 Qed.
 
-#[global] Instance Reflexive_eqit b1 b2 : Reflexive RR -> Reflexive (@eqit E _ _ RR b1 b2).
+#[global] Instance Equivalence_eqit_eq {E : Type -> Type} {R: Type} (b: bool):
+  Equivalence (@eqit E R R eq false false).
 Proof.
-  red; intros. ginit. apply Reflexive_eqit_gen; eauto.
+  constructor; try typeclasses eauto.
 Qed.
 
-#[global] Instance Symmetric_eqit b : Symmetric RR -> Symmetric (@eqit E _ _ RR b b).
+#[global] Instance Transitive_eutt {E R RR} : Transitive RR -> Transitive (@eutt E R R RR).
 Proof.
-  red; intros. apply eqit_flip.
-  eapply eqit_mon, H0; eauto.
+  red; intros. assert (TRANS := trans_rcompose RR). eapply eqit_mono, eqit_trans; eauto.
+  intros!. now apply TRANS. 
 Qed.
 
-#[global] Instance eq_sub_euttge:
-  subrelation (@eq_itree E _ _ RR) (euttge RR).
+
+#[global] Instance Transitive_elem {E R RR} (HT : Transitive RR)
+  {c: Chain (@eqit_mon E false false)}: Transitive (elem c R R RR).
 Proof.
-  ginit. pcofix CIH. intros.
-  punfold H0. gstep. red in H0 |- *.
-  hinduction H0 before CIH; subst; econstructor; try inv CHECK; pclearbot; auto 7 with paco itree.
+  assert (Hinf : inf_closed (X := forall R1 R2, (R1 -> R2 -> Prop) -> itree E R1 -> itree E R2 -> Prop)
+    (fun x => Transitive (x R R RR))).
+  { intros T HTr x y z Hxy Hyz i Hi. apply (HTr _ Hi) with y; [exact (Hxy i Hi) | exact (Hyz i Hi)]. }
+  revert c. apply (tower Hinf). intros c Htrans.
+  intros!. icbn in *. eapply Transitive_eqitF; eauto.
 Qed.
 
-#[global] Instance euttge_sub_eutt:
-  subrelation (@euttge E _ _ RR) (eutt RR).
+#[global] Instance Equivalence_elem {E R RR} (HT : Equivalence RR)
+  {c: Chain (@eqit_mon E false false)}: Equivalence (elem c R R RR).
+Proof.
+  constructor; typeclasses eauto.
+Qed.  
+
+Lemma rcompose_eql {R1 R2} (RR : R1 -> R2 -> Prop) : eq_rel (rcompose eq RR) RR.
+Proof.
+  split; [intros ?? []; now subst | intros ???; now econstructor].
+Qed.
+Lemma rcompose_eqr {R1 R2} (RR : R1 -> R2 -> Prop) : eq_rel (rcompose RR eq) RR.
 Proof.
-  ginit. pcofix CIH. intros.
-  punfold H0. gstep. red in H0 |- *.
-  hinduction H0 before CIH; subst; econstructor; pclearbot; auto 7 with paco itree.
+  split; [intros ?? []; now subst | intros ???; econstructor; eauto].
 Qed.
 
-#[global] Instance eq_sub_eutt:
-  subrelation (@eq_itree E _ _ RR) (eutt RR).
+#[global] Instance eutt_cong_eutt_eq {E R1 R2 RS}:
+  Proper (eutt eq ==> eutt eq ==> iff)
+         (@eutt E R1 R2 RS).
 Proof.
-  red; intros. eapply euttge_sub_eutt. eapply eq_sub_euttge. apply H.
+  repeat red. 
+  intros t t' EQ1 u u' EQ2.
+  split; intros EQUIV. 
+  - symmetry in EQ1. 
+    pose proof eqit_trans EQ1 EQUIV as EQUIV'.
+    rewrite rcompose_eql in EQUIV'.
+    pose proof eqit_trans EQUIV' EQ2 as EQUIV''.
+    now rewrite rcompose_eqr in EQUIV''.
+  - pose proof eqit_trans EQ1 EQUIV as EQUIV'.
+    rewrite rcompose_eql in EQUIV'.
+    symmetry in EQ2.
+    pose proof eqit_trans EQUIV' EQ2 as EQUIV''.
+    now rewrite rcompose_eqr in EQUIV''.
 Qed.
 
-End eqit_gen.
+#[global] Instance Equivalence_eutt {E R RR} : Equivalence RR -> Equivalence (@eutt E R R RR).
+Proof.
+  typeclasses eauto.
+Qed.
+
+#[global] Instance Transitive_euttge {E R RR} : Transitive RR -> Transitive (@euttge E R R RR).
+Proof.
+  red; intros. assert (TRANS := trans_rcompose RR). eapply eqit_mono, eqit_trans; eauto.
+  intros!. now apply TRANS. 
+Qed.
+
+#[global] Instance PreOrder_euttge {E R RR} : PreOrder RR -> PreOrder (@euttge E R R RR).
+Proof.
+  constructor; typeclasses eauto. 
+Qed.
+
+#[global] Instance eq_proper_eq {E R1 R2}
+  (RR : R1 -> R2 -> Prop):
+  Proper (eq_itree (E := E) eq ==> (eq_itree (R2 := R2) eq) ==> iff) (eq_itree eq). 
+Proof. 
+  split; 
+  intros!.
+  do 2 (etransitivity; symmetry; eauto).
+  do 2 (etransitivity; eauto); now symmetry. 
+Qed.
+
+
+
+(* Ongoing sanity tests *)
+Module Tests.
+  #[local] Parameter E : Type -> Type.
+  #[local] Parameter R1 R2 : Type.
+  #[local] Parameter RR : R1 -> R2 -> Prop.
+  #[local] Parameter t u : itree E R1.
+  #[local] Parameter v w : itree E R2.
+  #[local] Parameter (EQ1 : t ≅ u).
+  #[local] Parameter (EQUIV1 : t ≈ u).
+  #[local] Parameter (EQ2 : v ≅ w).
+  #[local] Parameter (EQUIV2 : v ≈ w).
+  #[local] Parameter (GT : v ≳ w).
+  #[local] Parameter (GT2 : w ≳ v).
+
+Goal eutt RR u v.
+    rewrite EQUIV2.
+    rewrite <- EQ2.
+    eapply eq_proper_euttC.
+    rewrite <- EQ1.
+    exact EQ1. 
+    rewrite EQ2, <- EQ2. 
+    exact EQ2. 
+    step. 
+    unstep. 
+    (* step.  *)
+    rewrite <- EQ1. 
+    rewrite <- GT. 
+    rewrite EQ1.
+    rewrite <- EQUIV1.  
+Abort. 
+
+  #[local] Parameter (EQUIV : u ≈⟨RR⟩ v).
+ 
+  (* Test for rewrites in [eutt]: [eq_itree eq], [] *)
+  Goal t ≈⟨RR⟩ w -> t ≈⟨RR⟩ w.
+    intros H.
+    rewrite EQ1.
+    rewrite EQ1 in H.
+    rewrite <- EQUIV1.
+    (* ↕ these are eutt up to eutt *)
+    rewrite <- EQUIV1 in H.
+    rewrite <- EQUIV2 in H. 
+    rewrite GT2.
+    rewrite <- GT2 in H.
+    rewrite GT.
+    rewrite <- GT in H.
+    (* no way to use symmetry: RR cannot be symmetric *)
+    Fail symmetry.
+    Fail symmetry in H.
+    rewrite <- GT. 
+    assumption. 
+  Qed.
+
+  Definition VE := fun _ : Type => Empty_set. 
+  #[local] Parameter (EQUIV_tt : eutt (E:= VE) eq (Ret tt) (Ret tt)).
+  Goal eutt (E:= VE) eq (Ret tt) (Ret tt). 
+    step.  
+    (* This should work *)
+    unstep. 
+    assert (eutt (E:= VE) eq (Ret tt) (Ret tt)). 
+    step.
+    (* we should be able to fold into observe form *)
+    rewrite observing_observe.
+Abort. 
+  Goal t ≅ u -> t ≅ u.
+    intros H.
+    rewrite EQ1.
+    rewrite EQ1 in H.
+    symmetry.
+    symmetry in H.
+    reflexivity.
+Qed. 
+   (* 2. next: this: euttge RR is proper wrt eq_itree RR - make sure this works *)
+  Goal t ≅ u -> v ≅⟨flip RR⟩ u -> t ≳⟨RR⟩ v -> t ≳⟨RR⟩ v.
+    intros EQ1 EQ2' H.
+    rewrite EQ1.
+    rewrite EQ2.
+    apply eqit_flip in EQ2'.
+    rewrite EQ2 in EQ2'.
+    eapply (eqit_mono RR RR false false); eauto. 
+     (* TO FIX: only going through subrelation is insuficient *)
+Qed. 
+
+  (* Test [coinduction] tactic, notations  *)
+  Goal u ≈ t -> t ≈ u.
+    icoinduction r CIH.
+    intros.
+    step. 
+    rewrite H. 
+    reflexivity. 
+Qed.  
+End Tests.
+
+#[global] Hint Resolve Reflexive_eqit : reflexivity.
+
+
 
-#[global] Hint Resolve Reflexive_eqit Reflexive_eqit_gen : reflexivity.
 
 Section eqit_eq.
 
@@ -534,36 +1414,23 @@ Section eqit_eq.
 
 Context {E : Type -> Type} {R : Type}.
 
-Local Notation eqit := (@eqit E R R eq).
+Local Notation eqit := (fun b1 b2 => @eqit E R R eq b1 b2).
 
 #[global] Instance Reflexive_eqitF_eq b1 b2 (sim : itree E R -> itree E R -> Prop)
-: Reflexive sim -> Reflexive (eqitF eq b1 b2 id sim).
+: Reflexive sim -> Reflexive (eqitF eq b1 b2 sim).
 Proof.
   apply Reflexive_eqitF; eauto.
 Qed.
 
 #[global] Instance Symmetric_eqitF_eq b (sim : itree E R -> itree E R -> Prop)
-: Symmetric sim -> Symmetric (eqitF eq b b id sim).
+: Symmetric sim -> Symmetric (eqitF eq b b sim).
 Proof.
-  apply Symmetric_eqitF; eauto.
+  apply Symmetric_eqitF; eauto. 
 Qed.
 
-#[global] Instance Reflexive_eqit__eq b1 b2 (sim : itree E R -> itree E R -> Prop)
-: Reflexive sim -> Reflexive (eqit_ eq b1 b2 id sim).
-Proof. apply Reflexive_eqit_; eauto. Qed.
-
-#[global] Instance Symmetric_eqit__eq b (sim : itree E R -> itree E R -> Prop)
-: Symmetric sim -> Symmetric (eqit_ eq b b id sim).
-Proof. apply Symmetric_eqit_; eauto. Qed.
 
 (** *** [eqit] is an equivalence relation *)
 
-#[global] Instance Reflexive_eqit_gen_eq b1 b2 (r rg: itree E R -> itree E R -> Prop) :
-  Reflexive (gpaco2 (eqit_ eq b1 b2 id) (eqitC eq b1 b2) r rg).
-Proof.
-  apply Reflexive_eqit_gen; eauto.
-Qed.
-
 #[global] Instance Reflexive_eqit_eq b1 b2 : Reflexive (eqit b1 b2).
 Proof.
   apply Reflexive_eqit; eauto.
@@ -575,32 +1442,43 @@ Proof.
 Qed.
 
 (** *** Congruence properties *)
-
 #[global] Instance eqit_observe b1 b2:
   Proper (eqit b1 b2 ==> going (eqit b1 b2)) (@observe E R).
 Proof.
-  constructor; punfold H; auto with itree.
-Qed.
+  constructor; step in H; step; auto with itree.  
+Qed. 
 
 #[global] Instance eqit_tauF b1 b2:
   Proper (eqit b1 b2 ==> going (eqit b1 b2)) (@TauF E R _).
 Proof.
-  constructor; pstep. econstructor. eauto.
+  constructor; step. econstructor. eauto.
 Qed.
 
 #[global] Instance eqit_VisF b1 b2 {u} (e: E u) :
   Proper (pointwise_relation _ (eqit b1 b2) ==> going (eqit b1 b2)) (VisF e).
 Proof.
-  constructor; red in H. unfold eqit in *. pstep; econstructor; auto with itree.
+  constructor; red in H. step; econstructor; auto with itree.
 Qed.
 
 #[global] Instance observing_sub_eqit l r :
   subrelation (observing eq) (eqit l r).
 Proof.
   repeat red; intros.
-  pstep. red. rewrite (observing_observe H). apply Reflexive_eqitF; eauto. left. apply reflexivity.
+  step. rewrite (observing_observe H). apply Reflexive_eqitF; eauto.
+Qed.
+
+#[global] Instance observing_sub_elem b1 b2 (c : Chain (eqit_mon b1 b2)) (l r : itree E R) :
+  subrelation (@observing E R R eq) (elem c R R eq).
+Proof.
+  intros!.
+  inv H.
+  step.
+  rewrite observing_observe.
+  step. reflexivity.
 Qed.
 
+
+
 (** ** Eta-expansion *)
 
 Lemma itree_eta_ (t : itree E R) : t ≅ go (_observe t).
@@ -614,32 +1492,39 @@ Proof. reflexivity. Qed.
 
 End eqit_eq.
 
+(* [cbn] that preserves eqit_mon. *)
+Ltac bcbn := cbn; to_mon; 
+repeat match goal with 
+| |- context [{| _observe := observe ?t |}] => rewrite <- (itree_eta t)
+end.  
+
+
 (** *** One-sided inversion *)
 
 Lemma eqitree_inv_Ret_r {E R} (t : itree E R) r :
   t ≅ (Ret r) -> observe t = RetF r.
 Proof.
-  intros; punfold H; inv H; try inv CHECK; eauto.
+  intros; sinv H.
 Qed.
 
 Lemma eqitree_inv_Vis_r {E R U} (t : itree E R) (e : E U) (k : U -> _) :
   t ≅ Vis e k -> exists k', observe t = VisF e k' /\ forall u, k' u ≅ k u.
 Proof.
-  intros; punfold H; apply eqitF_inv_VisF_r in H.
+  intros; step in H; apply eqitF_inv_VisF_r in H.
   destruct H as [ [? [-> ?]] | [] ]; [ | discriminate ].
-  pclearbot. eexists; split; eauto.
+  eexists; split; eauto.
 Qed.
 
 Lemma eqitree_inv_Tau_r {E R} (t t' : itree E R) :
   t ≅ Tau t' -> exists t0, observe t = TauF t0 /\ t0 ≅ t'.
 Proof.
-  intros; punfold H; inv H; try inv CHECK; pclearbot; eauto.
+  intros; sinv H; eauto.
 Qed.
 
 Lemma eqit_inv_Ret {E R1 R2 RR} b1 b2 r1 r2 :
   @eqit E R1 R2 RR b1 b2 (Ret r1) (Ret r2) -> RR r1 r2.
 Proof.
-  intros. punfold H. inv H. eauto.
+  intros. step in H. inv H. 
 Qed.
 
 (* Axiom-free, weaker version of [eqit_inv_vis] *)
@@ -648,9 +1533,8 @@ Lemma eqit_inv_Vis_weak {E R1 R2 RR} b1 b2
   eqit RR b1 b2 (Vis e1 k1) (Vis e2 k2) ->
   exists p, eqeq E p e1 e2 /\ pweqeq (eqit RR b1 b2) p k1 k2.
 Proof.
-  intros. punfold H; apply eqitF_inv_VisF_weak in H.
+  intros. step in H; apply eqitF_inv_VisF_weak in H.
   destruct H as [ p []]. exists p; split; auto.
-  revert H0; apply pweqeq_mon; intros; pclearbot; auto.
 Qed.
 
 (* This assumes UIP. *)
@@ -659,85 +1543,9 @@ Lemma eqit_inv_Vis {E R1 R2} (RR : R1 -> R2 -> Prop) b1 b2 U (e : E U)
   : eqit RR b1 b2 (Vis e k1) (Vis e k2) ->
     forall u, eqit RR b1 b2 (k1 u) (k2 u).
 Proof.
-  intros H x; punfold H; apply eqitF_inv_VisF with (x := x) in H; pclearbot; auto.
-Qed.
-
-Lemma eqit_inv_Tau_l {E R1 R2 RR} b1 t1 t2 :
-  @eqit E R1 R2 RR b1 true (Tau t1) t2 -> eqit RR b1 true t1 t2.
-Proof.
-  intros. punfold H. red in H. simpl in *.
-  remember (TauF t1) as tt1. genobs t2 ot2.
-  hinduction H before b1; intros; try discriminate.
-  - inv Heqtt1. pclearbot. pstep. red. simpobs. econstructor; eauto. pstep_reverse.
-  - inv Heqtt1. punfold_reverse H.
-  - red in IHeqitF. pstep. red; simpobs. econstructor; eauto. pstep_reverse.
-Qed.
-
-Lemma eqit_inv_Tau_r {E R1 R2 RR} b2 t1 t2 :
-  @eqit E R1 R2 RR true b2 t1 (Tau t2) -> eqit RR true b2 t1 t2.
-Proof.
-  intros. punfold H. red in H. simpl in *.
-  remember (TauF t2) as tt2. genobs t1 ot1.
-  hinduction H before b2; intros; try discriminate.
-  - inv Heqtt2. pclearbot. pstep. red. simpobs. econstructor; eauto. pstep_reverse.
-  - red in IHeqitF. pstep. red; simpobs. econstructor; eauto. pstep_reverse.
-  - inv Heqtt2. punfold_reverse H.
-Qed.
-
-Lemma eqit_inv_Tau {E R1 R2 RR} b1 b2 t1 t2 :
-  @eqit E R1 R2 RR b1 b2 (Tau t1) (Tau t2) -> eqit RR b1 b2 t1 t2.
-Proof with eauto with itree.
-  intros. punfold H. red in H. simpl in *.
-  remember (TauF t1) as tt1. remember (TauF t2) as tt2.
-  hinduction H before b2; intros; try discriminate.
-  - inv Heqtt1. inv Heqtt2. pclearbot. eauto.
-  - inv Heqtt1. inv H.
-    + pclearbot. punfold REL. pstep. red. simpobs...
-    + pstep. red. simpobs. econstructor; eauto. pstep_reverse. apply IHeqitF; eauto.
-    + eauto with itree.
-  - inv Heqtt2. inv H.
-    + pclearbot. punfold REL. pstep. red. simpobs...
-    + eauto with itree.
-    + pstep. red. simpobs. econstructor; auto. pstep_reverse. apply IHeqitF; eauto.
-Qed.
-
-Section eqit_inv.
-
-Context {E : Type -> Type} {R1 R2} {RR : R1 -> R2 -> Prop} {b1 b2 : bool}.
-Context {vclo : (itree E R1 -> itree E R2 -> Prop) -> (itree E R1 -> itree E R2 -> Prop)}.
-Context {sim : itree E R1 -> itree E R2 -> Prop}.
-
-Notation eqit__ t1_ t2_ :=
-  match _observe t1_, _observe t2_ with
-  | RetF r1, RetF r2 => RR r1 r2
-  | VisF e1 k1, VisF e2 k2 =>
-    exists p, eqeq E p e1 e2 /\ pweqeq (eqit RR b1 b2) p k1 k2
-  | RetF _, VisF _ _ | VisF _ _, RetF _ => False
-  | TauF t1, TauF t2 => eqit RR b1 b2 t1 t2
-  | TauF t1, _ =>
-    if b1 then eqit RR b1 b2 t1 t2_
-    else False
-  | _, TauF t2 =>
-    if b2 then eqit RR b1 b2 t1_ t2
-    else False
-  end.
-
-Lemma eqit_inv t1 t2 : eqit RR b1 b2 t1 t2 -> eqit__ t1 t2.
-Proof.
-  intros H; punfold H; red in H.
-  genobs t1 ot1; genobs t2 ot2; revert t1 t2 Heqot1 Heqot2; unfold observe, _observe.
-  destruct H; pclearbot; intros * E1 E2; rewrite <- E1, <- E2; cbn; auto.
-  - exists eq_refl; cbn; eauto.
-  - rewrite CHECK in *. destruct ot2.
-    1,3: pfold; red; unfold observe, _observe; rewrite <- E2; assumption.
-    1: apply eqit_inv_Tau_r; pfold; red; unfold observe, _observe; assumption.
-  - rewrite CHECK in *. destruct ot1.
-    1,3: pfold; red; unfold observe, _observe; rewrite <- E1; assumption.
-    1: apply eqit_inv_Tau_l; pfold; red; unfold observe, _observe; assumption.
+  intros H x; step in H; apply eqitF_inv_VisF with (x := x) in H; auto.
 Qed.
 
-End eqit_inv.
-
 Lemma eutt_inv_Ret {E R} r1 r2 :
   (Ret r1: itree E R) ≈ (Ret r2) -> r1 = r2.
 Proof.
@@ -753,13 +1561,13 @@ Qed.
 Lemma eqit_Tau_l {E R1 R2 RR} b2 (t1 : itree E R1) (t2 : itree E R2) :
   eqit RR true b2 t1 t2 -> eqit RR true b2 (Tau t1) t2.
 Proof.
-  intros. pstep. econstructor; eauto. punfold H.
+  intros. step. econstructor; eauto. now step in H. 
 Qed.
 
 Lemma eqit_Tau_r {E R1 R2 RR} b1 (t1 : itree E R1) (t2 : itree E R2) :
   eqit RR b1 true t1 t2 -> eqit RR b1 true t1 (Tau t2).
 Proof.
-  intros. pstep. econstructor; eauto. punfold H.
+  intros. step. econstructor; eauto. now step in H. 
 Qed.
 
 Lemma tau_euttge {E R} (t: itree E R) :
@@ -777,177 +1585,78 @@ Qed.
 
 Lemma simpobs {E R} {ot} {t: itree E R} (EQ: ot = observe t): t ≅ go ot.
 Proof.
-  pstep. repeat red. simpobs. simpl. subst. pstep_reverse. apply Reflexive_eqit; eauto.
+  step. repeat red. simpobs. simpl. subst. unstep. apply Reflexive_eqit; eauto.
 Qed.
 
 (** *** Transitivity properties *)
-
-Inductive rcompose {R1 R2 R3} (RR1: R1->R2->Prop) (RR2: R2->R3->Prop) (r1: R1) (r3: R3) : Prop :=
-| rcompose_intro r2 (REL1: RR1 r1 r2) (REL2: RR2 r2 r3)
-.
-#[global] Hint Constructors rcompose : itree.
-
-Lemma trans_rcompose {R} RR (TRANS: Transitive RR):
-  forall x y : R, rcompose RR RR x y -> RR x y.
-Proof.
-  intros. destruct H; eauto.
-Qed.
-
-Lemma eqit_trans {E R1 R2 R3} (RR1: R1->R2->Prop) (RR2: R2->R3->Prop) b1 b2 t1 t2 t3
-      (INL: eqit RR1 b1 b2 t1 t2)
-      (INR: eqit RR2 b1 b2 t2 t3):
-  @eqit E _ _ (rcompose RR1 RR2) b1 b2 t1 t3.
-Proof.
-  revert_until b2. pcofix CIH. intros.
-  pstep. punfold INL. punfold INR. red in INL, INR |- *. genobs_clear t3 ot3.
-  hinduction INL before CIH; intros; subst; clear t1 t2.
-  - remember (RetF r2) as ot.
-    hinduction INR before CIH; intros; inv Heqot; eauto with paco itree.
-  - assert (DEC: (exists m3, ot3 = TauF m3) \/ (forall m3, ot3 <> TauF m3)).
-    { destruct ot3; eauto; right; red; intros; inv H. }
-    destruct DEC as [EQ | EQ].
-    + destruct EQ as [m3 ?]; subst.
-      econstructor. right. pclearbot. eapply CIH; eauto with paco.
-      eapply eqit_inv_Tau. eauto with itree.
-    + inv INR; try (exfalso; eapply EQ; eauto; fail).
-      econstructor; eauto.
-      pclearbot. punfold REL. red in REL.
-      hinduction REL0 before CIH; intros; try (exfalso; eapply EQ; eauto; fail).
-      * remember (RetF r1) as ot.
-        hinduction REL0 before CIH; intros; inv Heqot; eauto with paco itree.
-      * remember (VisF e k1) as ot.
-        hinduction REL0 before CIH; intros; try discriminate; [ inv_Vis | eauto with itree ].
-        econstructor. intros. right.
-        destruct (REL v), (REL0 v); try contradiction. eauto.
-      * eapply IHREL0; eauto. pstep_reverse.
-        destruct b1; inv CHECK0.
-        apply eqit_inv_Tau_r. eauto with itree.
-  - remember (VisF e k2) as ot.
-    hinduction INR before CIH; intros; try discriminate; [ inv_Vis | eauto with itree ].
-    econstructor. intros.
-    destruct (REL v), (REL0 v); try contradiction; eauto with itree.
-  - eauto with itree.
-  - remember (TauF t0) as ot.
-    hinduction INR before CIH; intros; try inversion Heqot; subst.
-    2,3: eauto 3 with itree.
-    eapply IHINL. pclearbot. punfold REL. eauto with itree.
-Qed.
-
-#[global] Instance Transitive_eqit {E : Type -> Type} {R: Type} (RR : R -> R -> Prop) (b1 b2: bool):
-  Transitive RR -> Transitive (@eqit E _ _ RR b1 b2).
-Proof.
-  red; intros. assert (TRANS := trans_rcompose RR). eapply eqit_mon, eqit_trans; eauto.
-Qed.
-
-#[global] Instance Transitive_eqit_eq {E : Type -> Type} {R: Type} (b1 b2: bool):
-  Transitive (@eqit E R R eq b1 b2).
-Proof.
-  apply Transitive_eqit. repeat intro; subst; eauto.
-Qed.
-
-#[global] Instance Equivalence_eqit {E : Type -> Type} {R: Type} (RR : R -> R -> Prop) (b: bool):
-  Equivalence RR -> Equivalence (@eqit E R R RR b b).
-Proof.
-  constructor; try typeclasses eauto.
-Qed.
-
-#[global] Instance Equivalence_eqit_eq {E : Type -> Type} {R: Type} (b: bool):
-  Equivalence (@eqit E R R eq false false).
-Proof.
-  constructor; try typeclasses eauto.
-Qed.
-
-#[global] Instance Transitive_eutt {E R RR} : Transitive RR -> Transitive (@eutt E R R RR).
-Proof.
-  red; intros. assert (TRANS := trans_rcompose RR). eapply eqit_mon, eqit_trans; eauto.
-Qed.
-
-#[global] Instance Equivalence_eutt {E R RR} : Equivalence RR -> Equivalence (@eutt E R R RR).
-Proof.
-  constructor; try typeclasses eauto.
-Qed.
-
-#[global] Instance geuttgen_cong_eqit {E R1 R2 RR1 RR2 RS} b1 b2 r rg
-       (LERR1: forall x x' y, (RR1 x x': Prop) -> (RS x' y: Prop) -> RS x y)
-       (LERR2: forall x y y', (RR2 y y': Prop) -> RS x y' -> RS x y):
-  Proper (eq_itree RR1 ==> eq_itree RR2 ==> flip impl)
-         (gpaco2 (@eqit_ E R1 R2 RS b1 b2 id) (eqitC RS b1 b2) r rg).
-Proof.
-  repeat intro. guclo eqit_clo_trans. econstructor; cycle -3; eauto.
-  - eapply eqit_mon, H; eauto; discriminate.
-  - eapply eqit_mon, H0; eauto; discriminate.
-Qed.
-
-#[global] Instance geuttgen_cong_eqit_eq {E R1 R2 RS} b1 b2 r rg:
-  Proper (eq_itree eq ==> eq_itree eq ==> flip impl)
-         (gpaco2 (@eqit_ E R1 R2 RS b1 b2 id) (eqitC RS b1 b2) r rg).
-Proof.
-  eapply geuttgen_cong_eqit; intros; subst; eauto.
-Qed.
-
-#[global] Instance geuttge_cong_euttge {E R1 R2 RR1 RR2 RS} r rg
-       (LERR1: forall x x' y, (RR1 x x': Prop) -> (RS x' y: Prop) -> RS x y)
-       (LERR2: forall x y y', (RR2 y y': Prop) -> RS x y' -> RS x y):
-  Proper (euttge RR1 ==> eq_itree RR2 ==> flip impl)
-         (gpaco2 (@eqit_ E R1 R2 RS true false id) (eqitC RS true false) r rg).
-Proof.
-  repeat intro. guclo eqit_clo_trans. eauto with itree.
-Qed.
-
-#[global] Instance geuttge_cong_euttge_eq {E R1 R2 RS} r rg:
-  Proper (euttge eq ==> eq_itree eq ==> flip impl)
-         (gpaco2 (@eqit_ E R1 R2 RS true false id) (eqitC RS true false) r rg).
-Proof.
-  eapply geuttge_cong_euttge; intros; subst; eauto.
-Qed.
-
-#[global] Instance geutt_cong_euttge {E R1 R2 RR1 RR2 RS} r rg
-       (LERR1: forall x x' y, (RR1 x x': Prop) -> (RS x' y: Prop) -> RS x y)
-       (LERR2: forall x y y', (RR2 y y': Prop) -> RS x y' -> RS x y):
-  Proper (euttge RR1 ==> euttge RR2 ==> flip impl)
-         (gpaco2 (@eqit_ E R1 R2 RS true true id) (eqitC RS true true) r rg).
-Proof.
-  repeat intro. guclo eqit_clo_trans. eauto with itree.
-Qed.
-
-#[global] Instance geutt_cong_euttge_eq {E R1 R2 RS} r rg:
-  Proper (euttge eq ==> euttge eq ==> flip impl)
-         (gpaco2 (@eqit_ E R1 R2 RS true true id) (eqitC RS true true) r rg).
-Proof.
-  eapply geutt_cong_euttge; intros; subst; eauto.
-Qed.
-
+(* TOUR *)
 #[global] Instance eqitgen_cong_eqit {E R1 R2 RR1 RR2 RS} b1 b2
        (LERR1: forall x x' y, (RR1 x x': Prop) -> (RS x' y: Prop) -> RS x y)
-       (LERR2: forall x y y', (RR2 y y': Prop) -> RS x y' -> RS x y):
-  Proper (eq_itree RR1 ==> eq_itree RR2 ==> flip impl)
-         (@eqit E R1 R2 RS b1 b2).
-Proof.
-  ginit. intros. eapply geuttgen_cong_eqit; eauto. gfinal. eauto.
-Qed.
-
-#[global] Instance eqitgen_cong_eqit_eq {E R1 R2 RS} b1 b2:
-  Proper (eq_itree eq ==> eq_itree eq ==> flip impl)
-         (@eqit E R1 R2 RS b1 b2).
-Proof.
-  ginit. intros. rewrite H1, H0. gfinal. eauto.
-Qed.
-
-#[global] Instance euttge_cong_euttge {E R RS}
-       (TRANS: Transitive RS):
-  Proper (euttge RS ==> flip (euttge RS) ==> flip impl)
-         (@eqit E R R RS true false).
-Proof.
-  repeat intro. assert (HYP := trans_rcompose RS TRANS).
-  do 2 (eapply eqit_mon, eqit_trans; eauto).
-Qed.
+       (LERR2: forall x y y', (RR2 y y': Prop) -> RS x y' -> RS x y) : 
+       Proper (eq_itree RR1 ==> eq_itree RR2 ==> flip impl) 
+              (@eqit E R1 R2 RS b1 b2).
+Proof. 
+intros!; unfold flip, eq_itree in *. 
+
+  (* Given *)
+  (* LERR1: ∀ x x' y. RR1 x x' -> RS x' y -> RS x y *)
+  (* LERR2: ∀ x y y'. RR2 y y' -> RS x y' -> RS x y, *)
+  (* Prove the diagram commutes *)
+  
+  (* 
+   y -(eqit RS b1 b2) → y0 
+   ↑                    ↑
+   ≅RR1                ≅RR2
+   |                    | 
+   x -(?eqit RS b1 b2)→ x0
+  *)
+
+  (* Problem: this diagram does not have a path from x to x0. *)
+  (* Solution: flip ≅RR2, as both boolean flags are false to 
+    begin with this is a "symmetry" on trees only. *)
+
+(* 
+   y -(eqit RS b1 b2) → y0 
+   ↑                    |
+   ≅RR1                ≅(flip RR2)
+   |                    ↓ 
+   x -(?eqit RS b1 b2)→ x0
+
+(* This diagram has a clear path (lifting with eqit_mono), 
+  and LERR1 and LERR2 get us the correlaries we need to arrive there: namely: *)
+*)
+(*  by LERR1, Ret nodes of x and Ret nodes of y0 are related by RS. 
+    by LERR2, Ret nodes of x0 and Ret nodes of y are related by RS. 
+    RR1 ∘ RS <= RS 
+    (flip RR2) ∘ RS <= RS 
+    so RS is closed under left composition by RR1
+    and right composition by flip RR2.
+  *)
+  (* We use a mix of foreward and backward reasoning. *)
+  
+  idtac. 
+  (* build arrows and strengthen *)
+  assert (rcompose RR1 RS <= RS) by (intros ? ? [? ?]; eauto). 
+  assert (rcompose RS (flip RR2) <= RS) by (intros ? ? [? ?]; eauto).
+  assert (eqit RR1 b1 b2 x y) by 
+  (eapply eqit_mono with (b1:=false) (b2:=false) (RR:=RR1); easy).
+  assert (eqit RR2 b1 b2 x0 y0) by 
+  (eapply eqit_mono with (b1:=false) (b2:=false) (RR:=RR2); try easy).  
+
+  (* first diagonal *)
+  specialize (eqit_trans H4 H1) as Hdiag_weak. 
+  assert (eqit RS b1 b2 x y0) as Hdiag by 
+  (eapply eqit_mono with (RR:=(rcompose RR1 RS)); eauto).
+  
+  (* reverse the final arrow *)
+  apply eqit_flip in H0.
+  
+  (* backward reasoning, straightforward *)
+  eapply eqit_mono with (RR:=(rcompose RS (flip RR2))); eauto. 
+  eapply eqit_trans; eauto. 
+  eapply eqit_mono with (b1:=false) (b2:=false) (RR:=(flip RR2)); easy. 
+Qed. 
 
-#[global] Instance euttge_cong_euttge_eq {E R}:
-  Proper (euttge eq ==> flip (euttge eq) ==> flip impl)
-         (@eqit E R R eq true false).
-Proof.
-  eapply euttge_cong_euttge; eauto using eq_trans.
-Qed.
 
 
 (* Auxiliary results on [itree]s. *)
@@ -957,16 +1666,9 @@ Lemma tau_eutt_RR_l : forall E R (RR : relation R) (HRR: Reflexive RR) (HRT: Tra
 Proof.
   intros.
   split; intros H.
-  - eapply transitivity. 2 : { apply H. }
-    red. apply eqit_Tau_r. reflexivity.
-  - red. red. pstep. econstructor. auto. punfold H.
-Qed.
-
-Lemma tau_eqit_RR_l : forall E R (RR : relation R) (HRR: Reflexive RR) (HRT: Transitive RR) (t s : itree E R),
-    eqit RR true false t s -> eqit RR true false (Tau t) s.
-Proof.
-  intros.
-  red. pstep. econstructor. auto. punfold H.
+  - eapply transitivity. 2 : apply H. 
+    apply eqit_Tau_r. reflexivity.
+  - step. taul. now step in H. 
 Qed.
 
 Lemma tau_eutt_RR_r : forall E R (RR : relation R) (HRR: Reflexive RR) (HRT: Transitive RR) (t s : itree E R),
@@ -975,28 +1677,32 @@ Proof.
   intros.
   split; intros H.
   - eapply transitivity. apply H.
-    red. apply eqit_Tau_l. reflexivity.
-  - red. red. pstep. econstructor. auto. punfold H.
+    apply eqit_Tau_l. reflexivity.
+  - step. taur. now step in H.
 Qed.
 
 Lemma eutt_inv_Ret_l {E R} (r1: R) (t2: itree E R):
   (Ret r1) ≈ t2 -> t2 ≳ (Ret r1).
 Proof.
-  intros Heutt. punfold Heutt; red in Heutt; cbn in Heutt.
-  rewrite itree_eta. remember (RetF r1) as ot1.
-  induction Heutt; intros; try discriminate.
-  - inv Heqot1. reflexivity.
-  - inv Heqot1. rewrite tau_euttge. rewrite itree_eta. now apply IHHeutt.
+  intros Heutt. step in Heutt. 
+  rewrite itree_eta. 
+  remember (observe (Ret r1)).
+  genobs t2 ot2.
+  remember {| _observe := ot2 |}.
+  hinduction Heutt before r1; intros; inv Heqi. 
+  - rewrite tau_euttge. rewrite itree_eta. now eapply IHHeutt.
 Qed.
 
+(* The trick with these observe induction proofs 
+  is often to go 'as high as possible...' *)
 Lemma eutt_inv_Ret_r {E R} (t1: itree E R) (r2: R):
   t1 ≈ (Ret r2) -> t1 ≳ (Ret r2).
 Proof.
-  intros Heutt. punfold Heutt; red in Heutt; cbn in Heutt.
-  rewrite itree_eta. remember (RetF r2) as ot2.
-  induction Heutt; intros; try discriminate.
-  - inv Heqot2. reflexivity.
-  - inv Heqot2. rewrite tau_euttge. rewrite itree_eta. now apply IHHeutt.
+  intros Heutt. step in Heutt.  
+  rewrite itree_eta. 
+  remember (observe (Ret r2)); genobs t1 ot1; remember {| _observe := ot1 |}.
+  hinduction Heutt before R; intros; inv Heqi. 
+  - rewrite tau_euttge. rewrite itree_eta. now eapply IHHeutt.
 Qed.
 
 (** ** Equations for core combinators *)
@@ -1030,9 +1736,9 @@ Lemma bind_trigger {E R} U (e : E U) (k : U -> itree E R)
   : ITree.bind (ITree.trigger e) k ≅ Vis e (fun x => k x).
 Proof.
   rewrite unfold_bind; cbn.
-  pstep.
+  step.
   constructor.
-  intros; red. left. apply bind_ret_l.
+  intros. apply bind_ret_l.
 Qed.
 
 Lemma unfold_iter {E A B} (f : A -> itree E (A + B)) (x : A) :
@@ -1062,21 +1768,29 @@ Lemma eqit_Tau b1 b2 (t1 : itree E R1) (t2 : itree E R2) :
   eqit RR b1 b2 (Tau t1) (Tau t2) <-> eqit RR b1 b2 t1 t2.
 Proof.
   split; intros H.
-  - punfold H. red in H. simpl in *. pstep. red.
-    remember (TauF t1) as ot1. remember (TauF t2) as ot2.
-    hinduction H before RR; intros; subst; try inv Heqot1; try inv Heqot2; eauto.
-    + pclearbot. punfold REL.
-    + inv H; eauto with itree.
-    + inv H; eauto with itree.
-  - pstep. constructor; auto.
-Qed.
+  - step in H. step.  
+    move H before RR. revert_until H.
+    remember (observe (Tau t1)). 
+    remember (observe (Tau t2)). 
+    genobs t1 ot1. 
+    genobs t2 ot2. 
+    hinduction H before RR; intros; inv Heqi; try inv Heqi0. 
+    + now unstep. 
+    + inv H. 
+      * taul. eapply IHeqitF; eauto. 
+      * taul. eapply IHeqitF; eauto. 
+    + inv H. 
+      * taur. eapply IHeqitF; eauto. 
+      * taur. eapply IHeqitF; eauto. 
+  - step. now constructor.   
+Qed. 
 
 Lemma eqit_Vis_gen b1 b2 {U1 U2} (p : U1 = U2) (e1 : E U1) (e2 : E U2)
       (k1 : U1 -> itree E R1) (k2 : U2 -> itree E R2)
   : eqeq E p e1 e2 -> pweqeq (eqit RR b1 b2) p k1 k2 ->
     eqit RR b1 b2 (Vis e1 k1) (Vis e2 k2).
 Proof.
-  destruct p; cbn. intros <- H. pstep. econstructor. left. apply H.
+  destruct p; cbn. intros <- H. step. econstructor. apply H.
 Qed.
 
 Lemma eqit_Vis b1 b2 {U} (e : E U)
@@ -1091,58 +1805,84 @@ Lemma eqit_Ret b1 b2 (r1 : R1) (r2 : R2) :
   RR r1 r2 <-> @eqit E _ _ RR b1 b2 (Ret r1) (Ret r2).
 Proof.
   split; intros H.
-  - pstep. constructor; auto.
-  - punfold H. inversion H; subst; auto.
+  - step. now constructor.
+  - sinv H. 
 Qed.
 
 (** *** "Up-to" principles for coinduction. *)
 
-Inductive eqit_bind_clo b1 b2 (r : itree E R1 -> itree E R2 -> Prop) :
-  itree E R1 -> itree E R2 -> Prop :=
-| pbc_intro_h U1 U2 (RU : U1 -> U2 -> Prop) t1 t2 k1 k2
-      (EQV: eqit RU b1 b2 t1 t2)
-      (REL: forall u1 u2, RU u1 u2 -> r (k1 u1) (k2 u2))
-  : eqit_bind_clo b1 b2 r (ITree.bind t1 k1) (ITree.bind t2 k2)
-.
-Hint Constructors eqit_bind_clo : itree.
-
-Lemma eqit_clo_bind b1 b2 vclo
-      (MON: monotone2 vclo)
-      (CMP: compose (eqitC RR b1 b2) vclo <3= compose vclo (eqitC RR b1 b2))
-      (ID: id <3= vclo):
-  eqit_bind_clo b1 b2 <3= gupaco2 (eqit_ RR b1 b2 vclo) (eqitC RR b1 b2).
-Proof.
-  intros rr. pcofix CIH. intros. destruct PR.
-  guclo eqit_clo_trans. econstructor; auto_ctrans_eq.
-  1,2: rewrite unfold_bind; reflexivity.
-  punfold EQV. unfold_eqit.
-  hinduction EQV before CIH; intros; pclearbot; cbn;
-    repeat (change (ITree.subst ?k ?m) with (ITree.bind m k)).
-  - guclo eqit_clo_trans. econstructor; auto_ctrans_eq.
-    1,2: reflexivity.
-    eauto with paco.
-  - gstep. econstructor. eauto 7 with paco itree.
-  - gstep. econstructor. intros. red in CMP. unfold id in ID. apply ID. eauto 7 with paco itree.
-  - destruct b1; try discriminate.
-    guclo eqit_clo_trans.
-    econstructor; auto_ctrans_eq; eauto; try reflexivity.
-    eapply eqit_Tau_l. rewrite unfold_bind. reflexivity.
-  - destruct b2; try discriminate.
-    guclo eqit_clo_trans. econstructor; auto_ctrans_eq; eauto; try reflexivity.
-    eapply eqit_Tau_l. rewrite unfold_bind. reflexivity.
-Qed.
-
-Lemma eutt_clo_bind {U1 U2 UU} t1 t2 k1 k2
+(* One could consider making this a respectful instance. *)
+(* This might be good when doing other proofs, as it shows up 
+often. *)
+
+
+Lemma eqit_bind_chain
+ b1 b2 (c : Chain (eqit_mon b1 b2)) {U1 U2}
+ (t1 : itree E U1) (t2 : itree E U2) 
+ (k1 : U1 -> itree E R1) (k2 : U2 -> itree E R2) (UU : U1 -> U2 -> Prop) : 
+elem c _ _ UU t1 t2 -> 
+(forall u1 u2, UU u1 u2 -> elem c _ _ RR (k1 u1) (k2 u2)) -> 
+elem c _ _ RR (ITree.bind t1 k1) (ITree.bind t2 k2).
+Proof. 
+  revert_until U2. 
+  tower induction.
+ - intros. 
+  icbn in *. 
+  genobs t1 ot1.  
+  genobs t2 ot2.
+  hinduction H0 before RR; intros; try easy. 
+(* be careful not to rewrite all here; this will mess up taul and taur cases. *)
+  1-3: rewrite 2 observe_bind; simpobs.
+  (* ret *)
+  + eapply H1; eauto. 
+  (* taus *)
+  + constructor.
+    eapply H; eauto. 
+    intros; step; now eapply H1.
+  (* vis *)
+  + constructor. 
+    intro. 
+    eapply H; eauto.
+    intros; step; now eapply H1.
+  (* taul *)
+  + rewrite observe_bind. 
+    simpobs. 
+    taul. 
+    eapply IHeqitF; eauto.  
+  (* taur *)
+  + setoid_rewrite observe_bind at 2. 
+    simpobs. 
+    taur. 
+    eapply IHeqitF; eauto. 
+Qed. 
+
+Lemma eutt_bind_eutt {U1 U2 UU} t1 t2 k1 k2
       (EQT: @eutt E U1 U2 UU t1 t2)
       (EQK: forall u1 u2, UU u1 u2 -> eutt RR (k1 u1) (k2 u2)):
   eutt RR (ITree.bind t1 k1) (ITree.bind t2 k2).
 Proof.
-  intros. ginit. guclo eqit_clo_bind.
-  econstructor; eauto. intros; subst. gfinal. right. apply EQK. eauto.
-Qed.
+    unfold eutt. eapply eqit_bind_chain; eauto.  
+Qed. 
+
+Lemma eutt_bind_b {U1 U2 UU} t1 t2 k1 k2
+      (c : euttC)
+      (EQT: @eutt E U1 U2 UU t1 t2)
+      (EQK: forall u1 u2, UU u1 u2 -> eutt RR (k1 u1) (k2 u2)):
+  eqit_mon true true (elem c) _ _ RR (ITree.bind t1 k1) (ITree.bind t2 k2).
+Proof.
+    eapply eqit_bind_chain; intros. 
+    all: now do 2 step; [apply EQT || apply EQK].
+Qed. 
+
 
 End eqit_h.
 
+Ltac eret := constructor; eauto with itree. 
+Ltac etau := constructor; eauto with itree. 
+Ltac evis := constructor; intros; eauto with itree. 
+Ltac ebind := eapply eqit_bind_chain; eauto with itree.  
+
+
 Lemma eutt_Tau {E R} (t1 t2 : itree E R):
   Tau t1 ≈ Tau t2 <-> t1 ≈ t2.
 Proof.
@@ -1155,9 +1895,6 @@ Proof.
   apply eqit_Tau.
 Qed.
 
-Arguments eqit_clo_bind : clear implicits.
-#[global] Hint Constructors eqit_bind_clo : itree.
-
 Lemma eqit_bind' {E R1 R2 S1 S2} (RR : R1 -> R2 -> Prop) b1 b2
       (RS : S1 -> S2 -> Prop)
       t1 t2 k1 k2 :
@@ -1165,11 +1902,11 @@ Lemma eqit_bind' {E R1 R2 S1 S2} (RR : R1 -> R2 -> Prop) b1 b2
   (forall r1 r2, RR r1 r2 -> eqit RS b1 b2 (k1 r1) (k2 r2)) ->
   @eqit E _ _ RS b1 b2 (ITree.bind t1 k1) (ITree.bind t2 k2).
 Proof.
-  intros. ginit. guclo eqit_clo_bind. unfold eqit in *.
-  econstructor; eauto with paco.
+  intros.
+  eapply eqit_bind_chain; eauto. 
 Qed.
 
-Lemma eq_itree_clo_bind {E : Type -> Type} {R1 R2 : Type} (RR : R1 -> R2 -> Prop) {U1 U2 UU} t1 t2 k1 k2
+Lemma eq_itree_bind {E : Type -> Type} {R1 R2 : Type} (RR : R1 -> R2 -> Prop) {U1 U2 UU} t1 t2 k1 k2
       (EQT: @eq_itree E U1 U2 UU t1 t2)
       (EQK: forall u1 u2, UU u1 u2 -> eq_itree RR (k1 u1) (k2 u2)):
   eq_itree RR (ITree.bind t1 k1) (ITree.bind t2 k2).
@@ -1177,11 +1914,12 @@ Proof.
   eapply eqit_bind'; eauto.
 Qed.
 
+
 #[global] Instance eqit_subst {E R S} b1 b2 :
   Proper (pointwise_relation _ (eqit eq b1 b2) ==> eqit eq b1 b2 ==>
           eqit eq b1 b2) (@ITree.subst E R S).
 Proof.
-  repeat intro; eapply eqit_bind'; eauto.
+  intros!; eapply eqit_bind'; eauto.
   intros; subst; auto.
 Qed.
 
@@ -1189,7 +1927,7 @@ Qed.
   Proper (eqit eq b1 b2 ==> pointwise_relation _ (eqit eq b1 b2) ==>
           eqit eq b1 b2) (@ITree.bind E R S).
 Proof.
-  repeat intro; eapply eqit_bind'; eauto.
+  intros!; eapply eqit_bind'; eauto.
   intros; subst; auto.
 Qed.
 
@@ -1202,7 +1940,7 @@ Lemma eqit_map {E R1 R2 S1 S2} (RR : R1 -> R2 -> Prop) b1 b2
 Proof.
   unfold ITree.map; intros.
   eapply eqit_bind'; eauto.
-  intros; pstep; constructor; auto.
+  intros; step; constructor; auto.
 Qed.
 
 #[global] Instance eqit_eq_map {E R S} b1 b2 :
@@ -1210,18 +1948,67 @@ Qed.
           eqit eq b1 b2 ==>
           eqit eq b1 b2) (@ITree.map E R S).
 Proof.
-  repeat intro; eapply eqit_map; eauto.
+  intros!; eapply eqit_map; eauto.
   intros; subst; auto.
 Qed.
 
+#[global] Instance eqitF_cong_eqit {E R1} : 
+        Proper (@eq_itree E R1 _ eq ==> eq_itree eq ==> flip impl) 
+                (eqit_ false false (gfp (eqit_mon false false)) _ _ eq). 
+Proof. 
+  intros!. 
+  unstep. rewrite H. rewrite H0. now step. 
+Qed. 
+
+
+#[global] Instance trans_elem_eq_itree_mon {E R} (c : Chain (@eqit_mon E false false)) :
+  Transitive (elem c R R eq).
+Proof.
+  apply Transitive_elem. typeclasses eauto. 
+Qed.
+
+(* This lemma requires a bit of cleverness: [elem c], where [c] is [Chain
+(eqit_mon eq false false)], is respected by [observing eq]. Such respectfulness
+in turn reqires transitivity of [elem c] and the fact that [observing eq] is a
+subrelation of [elem c]. Some work in the reasoning, but with short proofs- and
+worth it! 
+*)
+#[global] Instance elem_observing_proper {E R} (c : Chain (@eqit_mon E false false)) :
+  Proper (observing eq ==> observing eq ==> flip impl) (elem c R R eq). 
+Proof. 
+  intros x y Hxy x' y' Hx'y' Helem.
+  symmetry in Hx'y'.  
+  eapply observing_sub_elem in Hxy; eauto.
+  eapply observing_sub_elem in Hx'y'; eauto.
+  do 2 (etransitivity; eauto).  
+Qed.   
+
+(* TOUR *)
 Lemma bind_ret_r {E R} :
   forall s : itree E R,
     ITree.bind s (fun x => Ret x) ≅ s.
 Proof.
-  ginit. pcofix CIH. intros.
-  rewrite (itree_eta_ (ITree.bind _ _)), (itree_eta s). cbn.
-  destruct (observe s); cbn; gstep; constructor; eauto with paco itree.
-Qed.
+  unfold eq_itree. intros.  
+  rewrite (itree_eta_ (ITree.bind _ _)), (itree_eta s).
+   (* we need to eta-expland first, but we have to be able 
+   to reduce later. *)
+  (* need strong CIH *)
+  revert s. 
+  icoinduction c CIH. 
+  intros.
+  (* with eta-reduction in place, we can reduce to base comparisons. *)
+  desobs s H; cbn; simpobs; constructor; intros.
+  (* Ret case is easy *)
+  reflexivity. 
+  (* the others are more tricky but mostly identical: *)
+  (* 1. we need only show the two sides are related by elem under [observe]. *)
+  all: eapply elem_observing_proper.
+  (* 2. we know they are by the CIH... *)
+  all: try eapply CIH.
+  (* 3. so the rest is just 'fancy reflexivity. *)
+  all: constructor; ITree.fold_subst.
+  all: simpl; reflexivity. 
+Qed. 
 
 Lemma bind_ret_r' {E R} (u : itree E R) (f : R -> R) :
   (forall x, f x = x) ->
@@ -1232,22 +2019,39 @@ Proof.
   - hnf. intros. apply eqit_Ret. auto.
 Qed.
 
+Ltac fold_subst := 
+  repeat match goal with 
+  |- context[ITree.subst ?k ?s] => 
+    replace (ITree.subst k s)
+    with (ITree.bind s k)
+    by reflexivity
+  end. 
+
 Lemma bind_bind {E R S T} :
   forall (s : itree E R) (k : R -> itree E S) (h : S -> itree E T),
     ITree.bind (ITree.bind s k) h ≅ ITree.bind s (fun r => ITree.bind (k r) h).
 Proof.
-  ginit. pcofix CIH. intros.
+  unfold eq_itree. intros. 
   lazymatch goal with
   | [ |- _ (ITree.bind ?t1 _) ?t2 ] => rewrite (itree_eta_ t1), (itree_eta_ t2); cbn
   end.
   lazymatch goal with
   | [ |- _ ?t0 _ ] => rewrite (itree_eta_ t0); cbn
   end.
-  destruct (observe s); cbn.
-  1: apply reflexivity.
-  all: gstep; constructor; eauto with paco itree.
+  revert s k h. 
+  icoinduction c CIH.
+  intros.
+  desobs s H; cbn; simpobs. 
+  1: step. reflexivity. 
+  all: constructor; intros; eapply elem_observing_proper.
+  all: try eapply CIH.
+  all: constructor. 
+  all: fold_subst. 
+  all: repeat rewrite observe_bind.
+  all: reflexivity.
 Qed.
 
+
 Lemma map_map {E R S T}: forall (f : R -> S) (g : S -> T) (t : itree E R),
     ITree.map g (ITree.map f t) ≅ ITree.map (fun x => g (f x)) t.
 Proof.
@@ -1316,7 +2120,6 @@ Ltac tau_steps :=
   tau_steps_left;
   tau_steps_right.
 
-
 Ltac force_left_in H :=
   match type of H with _ ?x _ => rewrite (itree_eta x) in H; cbn in H end.
 
@@ -1341,31 +2144,31 @@ Lemma eqit_inv_bind_ret:
          @eqit E R1 R2 RR b1 b2 (kb a) (Ret b).
 Proof.
   intros.
-  punfold H.
-  unfold eqit_ in *.
-  cbn in *.
+  step in H.
   remember (observe (ITree.bind ma kb)) as otl.
-  remember (RetF b) as tr.
-  revert ma kb Heqotl b Heqtr.
-  induction H; try discriminate.
+  remember (Ret b) as retb. 
+  remember (observe retb) as tr.
+  revert ma kb Heqotl b retb Heqretb Heqtr.
+  hinduction H before RR; intros; subst; try discriminate.
   - intros; subst.
-    inv Heqtr.
     unfold observe, _observe in Heqotl; cbn in Heqotl.
     destruct (observe ma) eqn:Ema; try discriminate.
     exists r. split.
     * rewrite itree_eta, Ema. reflexivity.
-    * rewrite itree_eta_. unfold _observe. rewrite <- Heqotl. pfold; constructor; auto.
+    * rewrite itree_eta_. unfold _observe. rewrite <- Heqotl. inv Heqtr. 
+    step; constructor; auto.
   - intros. subst.
     unfold observe, _observe in Heqotl; cbn in Heqotl.
     destruct (observe ma) eqn:Ema; try discriminate.
     + exists r. split.
       * rewrite itree_eta, Ema. reflexivity.
-      * pfold. red. unfold observe at 1; unfold _observe. rewrite <- Heqotl. constructor; auto.
-    + inv Heqotl. specialize (IHeqitF _ _ eq_refl _ eq_refl).
-      destruct IHeqitF as (a & ? & ?); exists a.
-      split; auto.
-      pfold; red; rewrite Ema. constructor; auto.
-      punfold H0.
+      * step. unfold observe at 1; unfold _observe. rewrite <- Heqotl. constructor; auto.
+    + inv Heqotl. 
+      edestruct IHeqitF; eauto. exists x. 
+      destruct H0. 
+      split; eauto.
+      step; rewrite Ema. taul. 
+      now step in H0. 
 Qed.
 
 Lemma eutt_inv_bind_ret:
@@ -1406,36 +2209,40 @@ Lemma eqit_inv_bind_vis :
                               forall (x:X), eqit RR b1 b2 (ITree.bind (kxa x) kab) (kxc x)) \/
     (exists (a : A), eqit eq b1 b2 ma (Ret a) /\ eqit RR b1 b2 (kab a) (Vis e kxc)).
 Proof.
-  intros. punfold H. unfold eqit_ in H. cbn in *.
+  intros. step in H. 
   remember (observe (ITree.bind ma kab)) as tl.
-  remember (VisF e kxc) as tr.
-  revert ma kab Heqtl kxc Heqtr.
-  induction H; try discriminate.
+  remember (Vis e kxc) as vis.
+  remember (observe vis) as tr. 
+  revert ma kab Heqtl kxc e vis Heqvis Heqtr.
+  induction H; try solve [intros; subst; discriminate].
   - intros. unfold observe, _observe in Heqtl; cbn in Heqtl.
     destruct (observe ma) eqn:Ema; try discriminate.
     + right. exists r. split.
-      * pfold; red. rewrite Ema. constructor. auto.
-      * pfold; red. unfold observe at 1; unfold _observe. rewrite <- Heqtl.
-        constructor; auto.
+      * step;  rewrite Ema. constructor. auto.
+      * step;  unfold observe at 1; unfold _observe. rewrite <- Heqtl.
+        simpobs. constructor; auto.
     + left.
       symmetry in Heqtl.
-      revert k2 REL Heqtr. inv_eq_VisF Heqtl. intros.
+
+      revert e0 Heqvis. revert k2 REL Heqtr. inv_eq_VisF Heqtl. intros.
+      inv Heqvis. 
+      cbn in Heqtr. 
       inv_eq_VisF Heqtr.
       exists k. split.
-      * pfold; red. rewrite Ema. constructor. red. left. apply reflexivity.
-      * pclearbot. auto.
+      * step;  rewrite Ema. constructor.  reflexivity.
+      * auto.
   - intros. subst.
     unfold observe, _observe in Heqtl; cbn in Heqtl.
     destruct (observe ma) eqn: Ema; try discriminate.
     + right; exists r; split.
       * rewrite itree_eta, Ema; reflexivity.
-      * pfold. red. unfold observe at 1; unfold _observe; rewrite <- Heqtl. constructor; auto.
-    + inv Heqtl. specialize (IHeqitF _ _ eq_refl _ eq_refl).
+      * step.  unfold observe at 1; unfold _observe; rewrite <- Heqtl. constructor; auto.
+    + inv Heqtl. specialize (IHeqitF _ _ eq_refl _ _ _ eq_refl eq_refl).
       destruct IHeqitF as [(k0 & ? & ?) | (a & ? & ?)]; [left | right].
       * exists k0. split; auto.
-        pfold; red; rewrite Ema; constructor; punfold H0.
+        step; icbn; rewrite Ema; constructor; now step in H0. 
       * exists a. split; auto.
-        pfold; red; rewrite Ema; constructor; punfold H0.
+        step; icbn; rewrite Ema; constructor; now step in H0.
 Qed.
 
 Lemma eutt_inv_bind_vis:
@@ -1465,35 +2272,36 @@ Lemma eqit_inv_bind_tau:
     (exists (ma' : itree E A), eqit eq b1 b2 ma (Tau ma') /\ eqit RR b1 b2 (ITree.bind ma' kab) tc) \/
     (exists (a : A), eqit eq b1 b2 ma (Ret a) /\ eqit RR b1 b2 (kab a) (Tau tc)).
 Proof.
-  intros. punfold H. unfold eqit_ in H. cbn in H.
+  intros. step in H. 
   remember (observe (ITree.bind ma kab)) as tl.
-  remember (TauF tc) as tr.
-  revert ma kab Heqtl Heqtr.
-  induction H; try discriminate; intros.
+  remember (Tau tc) as tau.
+  remember (observe tau) as tr.
+  revert ma kab Heqtl tc tau Heqtau Heqtr.
+  induction H; intros; try solve [subst; discriminate].
   - inv Heqtr. unfold observe, _observe in Heqtl; cbn in Heqtl.
     destruct (observe ma) eqn:Ema; try discriminate.
     + right; exists r; split.
-      * pfold; red; rewrite Ema; constructor; auto.
-      * pfold; red; unfold observe at 1; unfold _observe; rewrite <- Heqtl. constructor; auto.
+      * step; icbn; rewrite Ema; constructor; auto.
+      * step; icbn; inv H0; unfold observe, _observe; rewrite <- Heqtl; now constructor.
     + left; exists t; split.
-      * pfold; red; rewrite Ema; constructor; left; apply reflexivity.
-      * inv Heqtl. pclearbot. assumption.
+      * step; icbn; rewrite Ema; constructor; apply reflexivity.
+      * inv Heqtl. inv H0. 
   - subst.
     unfold observe, _observe in Heqtl; cbn in Heqtl.
     destruct (observe ma) eqn:Ema; try discriminate.
     + right; exists r; split.
-      * pfold; red; rewrite Ema; constructor; auto.
-      * pfold; red; unfold observe at 1; unfold _observe; rewrite <- Heqtl. constructor 4; auto.
-    + inv Heqtl. specialize (IHeqitF _ _ eq_refl eq_refl).
+      * step; icbn; rewrite Ema; constructor; auto.
+      * step; icbn; unfold observe at 1; unfold _observe; rewrite <- Heqtl. constructor 4; auto.
+    + inv Heqtl. specialize (IHeqitF _ _ eq_refl _ _ eq_refl eq_refl).
       destruct IHeqitF as [(t0 & ? & ?) | (a & ? & ?)]; [left | right].
       * exists t0. split; auto.
-        pfold; red; rewrite Ema; constructor 4; punfold H0.
+        step; icbn; rewrite Ema; constructor 4; now step in H0.
       * exists a. split; auto.
-        pfold; red; rewrite Ema; constructor; punfold H0.
+        step; icbn; rewrite Ema; constructor; now step in H0.
   - inv Heqtr.
     left; exists ma; split.
-    + pfold; constructor; auto. apply Reflexive_eqitF_eq. intros ?; left; apply reflexivity.
-    + pfold; assumption.
+    + step; constructor; auto. 
+    + inv H1; step; assumption.
 Qed.
 
 Lemma eutt_inv_bind_tau:
@@ -1518,58 +2326,286 @@ Lemma eutt_Ret_spin_abs: forall {E R1 R2} {RR: R1 -> R2 -> Prop} (v: R1),
     eutt RR (Ret v) (@ITree.spin E R2) -> False.
 Proof.
   intros.
-  punfold H.
-  unfold eqit_ in H.
+  step in H.
   remember (observe (Ret v)) as x.
   remember (observe (ITree.spin)) as sp.
   revert Heqx Heqsp.
   induction H; intros EQ1 EQ2; try (now inv EQ1 || now inv EQ2).
   - apply IHeqitF; auto.
     inv EQ2.
-    reflexivity.
 Qed.
 
 Lemma eutt_spin_Ret_abs: forall {E R1 R2} {RR: R1 -> R2 -> Prop} (v: R2),
     eutt RR (@ITree.spin E R1) (Ret v) -> False.
 Proof.
   intros.
-  punfold H.
-  unfold eqit_ in H.
+  step in H.
   remember (observe (Ret v)) as x.
   remember (observe (ITree.spin)) as sp.
   revert Heqx Heqsp.
   induction H; intros EQ1 EQ2; try (now inv EQ1 || now inv EQ2).
   - apply IHeqitF; auto.
     inv EQ2.
-    reflexivity.
 Qed.
 
 Lemma eutt_Vis_spin_abs: forall {E R1 R2} {RR: R1 -> R2 -> Prop} {X} (e: E X) (k: X -> itree E R1),
     eutt RR (Vis e k) (@ITree.spin E R2) -> False.
 Proof.
   intros.
-  punfold H.
-  unfold eqit_ in H.
+  step in H.
   remember (observe (Vis e k)) as x.
   remember (observe (ITree.spin)) as sp.
   revert Heqx Heqsp.
   induction H; intros EQ1 EQ2; try (now inv EQ1 || now inv EQ2).
   - apply IHeqitF; auto.
     inv EQ2.
-    reflexivity.
 Qed.
 
 Lemma eutt_spin_Vis_abs: forall {E R1 R2} {RR: R1 -> R2 -> Prop} {X} (e: E X) (k: X -> itree E R2),
     eutt RR (@ITree.spin E R1) (Vis e k) -> False.
 Proof.
   intros.
-  punfold H.
-  unfold eqit_ in H.
+  step in H.
   remember (observe (Vis e k)) as x.
   remember (observe (ITree.spin)) as sp.
   revert Heqx Heqsp.
   induction H; intros EQ1 EQ2; try (now inv EQ1 || now inv EQ2).
   - apply IHeqitF; auto.
     inv EQ2.
-    reflexivity.
 Qed.
+Section eqit_elem. 
+(*** *** Properties of the chain. *)
+
+Context {E : Type -> Type} {R1 R2} {RR : R1 -> R2 -> Prop} {b1 b2 : bool}.
+
+Ltac euttsimpl := unfold eutt, euttge, eq_itree, eqit in *. 
+
+Lemma Equivalence_elem_ff R RS (c : Chain (@eqit_mon E false false)) :
+Equivalence RS -> Equivalence (elem c R R RS).
+Proof.
+  constructor; typeclasses eauto.
+Qed.
+
+Lemma Reflexive_elem_eutt R RS (c : Chain (@eqit_mon E true true)) :
+      Reflexive RS -> Reflexive (elem c R R RS).
+Proof. typeclasses eauto. Qed.
+
+Lemma Symmetric_elem_eutt R RS (c : Chain (@eqit_mon E true true)) :
+      Symmetric RS -> Symmetric (elem c R R RS).
+Proof. typeclasses eauto. Qed.
+
+(* A very important lemma *)
+Lemma Proper_elem_bind X1 X2 Y1 Y2 RX SS u v k g 
+  (c : Chain (eqit_mon b1 b2)) : 
+  eqit RX b1 b2 u v -> (forall x1 x2, RX x1 x2 -> elem c _ _ SS (k x1) (g x2)) -> 
+  elem c _ _ SS (@ITree.bind E X1 Y1 u k) (@ITree.bind E X2 Y2 v g).
+Proof.
+  intros. eapply eqit_bind_chain; eauto. now do 2 step. 
+Qed. 
+
+
+(* We can't state this nicely as a Proper relation, since proper instances
+need to have subcomponents that share types. eutt RX violates this, as 
+u and v are of different types. *)
+
+End eqit_elem. 
+
+Section eutt_facts. 
+
+(** * Equivalence up to taus *)
+
+(** Abbreviated as [eutt]. *)
+
+(** We consider [Tau] as an "internal step", that should not be
+   visible to the outside world, so adding or removing [Tau]
+   constructors from an itree should produce an equivalent itree.
+
+   We must be careful because there may be infinite sequences of
+   taus (i.e., [spin]). Here we shall only allow inserting finitely
+   many [Tau]s between any two visible steps ([Ret] or [Vis]), so that
+   [spin] is only related to itself. This ensures that equivalence
+   up to taus is transitive (and in fact an equivalence relation).
+ *)
+
+(** A rewrite hint database named [itree] is available via the tactic
+    [autorewrite with itree] as a custom simplifier of expressions using
+    mainly [Ret], [Tau], [Vis], [ITree.bind] and [ITree.Interp.Interp.interp].
+ *)
+
+(** This file contains only the definition of the [eutt] relation.
+    Theorems about [eutt] are split in two more modules:
+
+    - [ITree.Eq.UpToTausCore] proves that [eutt] is reflexive, symmetric,
+      and that [ITree.Eq.Eqit.eq_itree] is a subrelation of [eutt].
+      Equations for [ITree.Core.ITreeDefinition] combinators which only rely on
+      those properties can also be found here.
+
+    - [ITree.Eq.UpToTausEquivalence] proves that [eutt] is transitive,
+      and, more generally, contains theorems for up-to reasoning in
+      coinductive proofs.
+ *)
+
+
+#[global]
+Instance eutt_cong_eutt {E R1 R2 RR} :
+  Proper (eutt eq ==> eutt eq ==> iff) (@eutt E R1 R2 RR).
+Proof.
+  intros!. now rewrite H, H0.
+Qed.
+
+#[global]
+Instance eutt_cong_euttge {E R1 R2 RR}:
+  Proper (euttge eq ==> euttge eq ==> iff)
+         (@eutt E R1 R2 RR).
+Proof.
+  intros!. now rewrite H, H0.
+Qed.
+
+#[global]
+Instance eutt_cong_eq {E R1 R2 RR}:
+  Proper (eq_itree eq ==> eq_itree eq ==> iff)
+         (@eutt E R1 R2 RR).
+Proof.
+  intros!. now rewrite H, H0.
+Qed.
+
+
+
+(* Specialization of [eutt_bind_eutt] to the recurrent case where [UU := eq]
+   in order to avoid having to provide the relation manually everytime *)
+Lemma eutt_eq_bind : forall E R1 R2 RR U (t: itree E U) (k1: U -> itree E R1) (k2: U -> itree E R2),
+    (forall u, eutt RR (k1 u) (k2 u)) -> eutt RR (ITree.bind t k1) (ITree.bind t k2).
+Proof.
+  intros.
+  apply eutt_bind_eutt with (UU := Logic.eq); [reflexivity |].
+  intros ? ? ->; apply H.
+Qed.
+
+(* Further specialization for [RR := eq] *)
+Lemma eutt_eq_bind' {E U R} (t1 t2: itree E U) (k1 k2: U -> itree E R):
+  t1 ≈ t2 ->
+  (forall u, (k1 u) ≈ (k2 u)) ->
+  (ITree.bind t1 k1) ≈ (ITree.bind t2 k2).
+Proof.
+  intros -> Hk. now apply eutt_eq_bind.
+Qed.
+
+(* Exposing a version specialized to [eutt] so that users don't have to know about [eqit] *)
+Lemma eutt_Ret :
+  forall E (R1 R2 : Type) (RR : R1 -> R2 -> Prop) r1 r2, RR r1 r2 <-> eutt (E := E) RR (Ret r1) (Ret r2).
+Proof.
+  intros; apply eqit_Ret.
+Qed.
+
+(* [eutt] can be thought as the elementary block of a relational program logic.
+   The following few lemmas give elementary logical rules to compose proofs.
+ *)
+ Open Scope relationH_scope. 
+Lemma eutt_conj {E} {R S} {RS RS'} :
+  forall (t : itree E R) (s : itree E S),
+    eutt RS  t s ->
+    eutt RS' t s ->
+    eutt (conj_rel RS RS') t s.
+Proof.
+  icoinduction c CIH. intros * EQ EQ'.
+  step in EQ; step in EQ'. 
+  genobs t ot; genobs s os.
+  hinduction EQ before CIH; subst; intros; simpl.
+  - inv EQ'. eret. now constructor. 
+  - taus. eapply CIH; eauto. apply eqit_inv_Tau. now step.  
+  - constructor. intro v. specialize (REL v).
+    eapply CIH; eauto. 
+    now eapply eqitF_inv_VisF in EQ'; eauto.
+  - taul. eapply IHEQ; eauto. subst. unstep. eapply eqit_inv_Tau_l. 
+    now step.  
+  - taur. eapply IHEQ; eauto. subst. unstep. eapply eqit_inv_Tau_r. 
+    now step.  
+Qed.
+
+Lemma eutt_disj_l {E} {R S} {RS RS'} :
+  forall (t : itree E R) (s : itree E S),
+    eutt RS t s ->
+    eutt (cup RS RS') t s. 
+Proof.
+  intros.
+  eapply (eqit_mono RS _); eauto.
+Qed.
+
+Lemma eutt_disj_r {E} {R S} {RS RS'} :
+  forall (t : itree E R) (s : itree E S),
+    eutt RS' t s ->
+    eutt (cup RS RS') t s. 
+Proof.
+  intros.
+  eapply (eqit_mono RS' _); eauto.
+Qed.
+
+Lemma eutt_equiv {E} {R S} {RS RS'} :
+  forall (t : itree E R) (s : itree E S),
+    (HeterogeneousRelations.eq_rel RS RS') ->
+    eutt RS t s <-> eutt RS' t s. 
+Proof.
+  intros * EQ; split; intros EUTT; eapply eqit_mono; try apply EUTT; eauto.
+  all: apply EQ.
+Qed.
+
+(* Rewriting equivalent simulation relations under [eq_itree] and [eutt] *)
+#[global]
+Instance eq_itree_Proper_R_Het {E : Type -> Type} {R1 R2:Type}
+  : Proper ((@HeterogeneousRelations.eq_rel R1 R2) ==> Logic.eq ==> Logic.eq ==> iff) (@eq_itree E R1 R2).
+Proof.
+  intros!; subst.
+  unfold eq_itree; rewrite H; reflexivity.
+Qed.
+
+#[global]
+Instance eutt_Proper_R_Het {E : Type -> Type} {R1 R2:Type}
+  : Proper  ((@HeterogeneousRelations.eq_rel R1 R2) ==> eq ==> eq ==> iff) (@eutt E R1 R2).
+Proof.
+  intros!; subst.
+  unfold eutt; rewrite H; reflexivity.
+Qed.
+
+(* Stronger subrelation result which applies for [eutt RR t t]. This is
+   relevant for post-conditions *)
+Lemma eutt_sub_self {E R} (R1 R2: R -> R -> Prop) (t: itree E R):
+  (forall r, R1 r r -> R2 r r) ->
+  eutt R1 t t ->
+  eutt R2 t t.
+Proof.
+  intros Hrel; revert t. icoinduction c CIH; intros t Heutt.
+  step in Heutt.
+  remember t as t' in Heutt at 2. assert (Ht': t' ≈ t) by now subst. clear Heqt'.
+  rewrite (itree_eta t), (itree_eta t') in Ht'.
+  revert Ht'. induction Heutt; clear t; intros Heq.
+  - apply eutt_inv_Ret in Heq; subst.
+    constructor; auto.
+  - apply eqit_inv_Tau in Heq.
+    constructor. eapply CIH. 
+    now rewrite <- Heq at 2.
+  - constructor. intros v. eapply eqit_inv_Vis in Heq.
+    specialize (REL v). eapply CIH. now rewrite <- Heq at 2.
+  - taul; taur. apply IHHeutt. rewrite <- (itree_eta t1).   
+    now rewrite tau_euttge in Heq. 
+  - apply IHHeutt. rewrite <- (itree_eta).   
+    now rewrite tau_euttge in Heq. 
+Qed.
+
+End eutt_facts. 
+
+(* Finally, recovering rewrites under eqitF. 
+Note: this is somewhat fragile, and can cause performance issues. *)
+#[global] Instance observing_eq_chain E R b1 b2 
+  (c : Chain (eqit_mon b1 b2)) : 
+  Proper ((@eq_itree E R R eq) ==> @eqitF E R R eq b1 b2 (elem c _ _ eq)) (observe). 
+Proof. 
+  intros!. 
+  step. rewrite H. reflexivity. 
+Qed.  
+  
+
+#[global] Instance observing_eq_eqitF E R b1 b2 : 
+  Proper ((@eq_itree E R R eq) ==> @eqitF E R R eq b1 b2 (eqit eq b1 b2)) (observe). 
+Proof. 
+  intros!; now eapply observing_eq_chain.
+Qed. 
\ No newline at end of file
diff --git a/theories/Eq/EuttExtras.v b/theories/Eq/EuttExtras.v
deleted file mode 100644
index 41eb3d52..00000000
--- a/theories/Eq/EuttExtras.v
+++ /dev/null
@@ -1,33 +0,0 @@
-(** * More facts about eutt *)
-
-(** ... that have been added recently and I don't know where to put. *)
-
-(* TODO: Figure out some way to organize Eq/UpToTaus.v and Eq/Eq.v *)
-
-From Paco Require Import paco.
-
-From ITree Require Import
-  Core.ITreeDefinition
-  Eq.Eqit.
-
-Lemma paco2_eqit_refl : forall E R r (t : itree E R), paco2 (eqit_ eq true true id) r t t.
-Proof.
-  intros. eapply paco2_mon with (r := bot2).
-  { enough (t ≈ t); auto. reflexivity. }
-  { contradiction. }
-Qed.
-
-Lemma eutt_subrel : forall (E : Type -> Type) (A B : Type) (R1 R2 : A -> B -> Prop)
-                           (ta : itree E A) (tb : itree E B),
-    (forall a b, R1 a b -> R2 a b) -> eutt R1 ta tb -> eutt R2 ta tb.
-Proof.
-  intros. eapply eqit_mon; eauto.
-Qed.
-
-Lemma eutt_flip : forall (E : Type -> Type) (A B : Type) (R : A -> B -> Prop)
-                         (ta : itree E A) (tb : itree E B),
-    eutt R ta tb -> eutt (flip R) tb ta.
-Proof.
-  intros. apply eqit_flip. 
-  eapply eutt_subrel with (R1 := R); eauto.
-Qed.
diff --git a/theories/Eq/Paco2.v b/theories/Eq/Paco2.v
deleted file mode 100644
index 4250f345..00000000
--- a/theories/Eq/Paco2.v
+++ /dev/null
@@ -1,182 +0,0 @@
-(** Redefinition of [pcofix] and [pcofix] without using the [JMeq_eq] axiom.
-Both tactics are now called [pcofix]. The same core is reused to define [ecofix]
-in [Eq.UpToTaus]. *)
-
-From Paco Require Import paco.
-
-Ltac debug_goal :=
-  match goal with
-  | [ |- ?G ] => idtac G
-  end.
-
-(* A variant of [paco2_acc] that is more convenient to use in the [pcofix] tactic. *)
-Lemma paco2_accF
-  : forall {T0 : Type} {T1 : forall a : T0, Type}
-      (gf : rel2 T0 T1 -> rel2 T0 T1) (r : rel2 T0 T1)
-      (X : Type)
-      (f0 : X -> T0) (f1 : forall x : X, T1 (f0 x)),
-      (forall rr : rel2 T0 T1,
-        (forall a0 a1, r a0 a1 -> rr a0 a1) ->
-        (forall x, rr (f0 x) (f1 x)) ->
-        forall x : X, paco2 gf rr (f0 x) (f1 x)) ->
-      forall x : X, paco2 gf r (f0 x) (f1 x).
-Proof.
-  intros.
-  apply paco2_acc with
-    (l := fun a0 (a1 : T1 a0) => exists x, existT _ (f0 x) (f1 x) = existT _ a0 a1); [ | eauto ].
-  intros rr INC CIH x0 x1 PR. change (paco2 gf rr (projT1 (existT _ _ x1)) (projT2 (existT _ _ x1))).
-  destruct PR as [? <-].
-  eauto.
-Qed.
-
-Lemma gpaco2_accF
-  : forall {T0 : Type} {T1 : forall a : T0, Type}
-      (gf : rel2 T0 T1 -> rel2 T0 T1),
-      monotone2 gf ->
-    forall (clo : rel2 T0 T1 -> rel2 T0 T1) (r rg : rel2 T0 T1)
-      (X : Type)
-      (f0 : X -> T0) (f1 : forall x : X, T1 (f0 x))
-      (OBG : forall rr : rel2 T0 T1,
-        (forall x y, rg x y -> rr x y) ->
-        (forall x, rr (f0 x) (f1 x)) ->
-        forall x : X, gpaco2 gf clo r rr (f0 x) (f1 x)),
-      forall x : X, gpaco2 gf clo r rg (f0 x) (f1 x).
-Proof.
-  intros.
-  apply gpaco2_cofix with
-    (l := fun a0 (a1 : T1 a0) => exists x, existT _ (f0 x) (f1 x) = existT _ a0 a1); [ eauto | | eauto ].
-  intros. change (gpaco2 gf clo r rr (projT1 (existT _ _ x1)) (projT2 (existT _ _ x1))).
-  destruct PR as [? <-].
-  eauto.
-Qed.
-
-Ltac apply_paco_acc self unpack_goal unpack_hyp :=
-  let unpack _tt :=
-    let r := fresh "r" in
-    let self_ := fresh "_tmp_" self in
-    let self := fresh self in
-    intros r self_ self;
-    let self1 := fresh self in
-    rename self_ into self1;
-    unpack_goal tt;
-    unpack_hyp self in
-  lazymatch goal with
-  | [ |- forall _, paco2 ?gf ?r0 _ _ ] => apply paco2_accF; unpack tt
-  | [ |- forall _, gpaco2 ?gf ?clo _ _ _ _ ] => apply gpaco2_accF; [ eauto with paco | unpack tt ]
-  (* TODO: other arities *)
-  | _ => fail "paco not found at the head of the goal"
-  end.
-
-Lemma curry_sig {A : Type} {P : A -> Type} {Q : forall (a : A) (b : P a), Prop}
-  : (forall x : sigT P, Q (projT1 x) (projT2 x)) -> forall (a : A) (p : P a), Q a p.
-Proof.
-  exact (fun H a p => H (existT _ a p)).
-Qed.
-
-(* [pcofix self]: Apply coinduction to a goal with [paco] at the head of the conclusion
-   (possibly after unfolding definitions).
-   The parameter [self] is the name of the coinduction hypothesis. *)
-
-(* Internal definition of [pcofix_]:
-Example initial goal:
-<<
-===========
-forall (x : X) (y : Y), hyp x y -> paco2 gf bot2 (f0 x y) (f1 x y)
->>
-   1. [pcofix_] first recursively introduces all hypotheses [H], being careful to
-      preserve existing names, and at the same time builds up continuations
-      to process the goal once we reach the conclusion. This technique has the
-      benefit that the name of each hypothesis is available, so it does
-      not need to be guessed repeatedly.
-Goal after step 1:
-<<
-x : X
-y : Y
-H : hyp x y
-===========
-paco2 gf bot2 (f0 x y) (f1 x y)
->>
-   2. Having reached the conclusion, we use the [pack_goal0] continuation to
-      regeneralize the hypotheses we introduced into a single sigma type
-      (a chain of [{_ & _}]/[sigT]),
-Goal after step 2:
-<<
-===========
-forall (u : {x : X & {y : Y & {_ : hyp x y & unit}}}),
-  paco2 gf bot2 (f0 (projT1 u) (projT2 u)) (f1 (projT1 u) (projT2 u))
->>
-   3. We can now apply [paco2_accF] (depending on the arity of paco)
-Goal after step 3:
-<<
-r : rel2 T0 T1
-_pacotmp_SELF: forall (u : _), r (f0 (projT1 u) (projT2 u)) (f1 (projT1 u) (projT2 u))
-==========
-forall (u : {x : X & {y : Y & {_ : hyp x y & unit}}}),
-  paco2 gf r (f0 (projT1 u) (projT2 u)) (f1 (projT1 u) (projT2 u))
->>
-   4. We decompose the tuple in the goal using the [unpack_goal0] continuation
-      (basically the reverse of [pack_goal0]) and [revert_tmp0].
-Goal after step 4:
-<<
-r : rel2 T0 T1
-_pacotmp_SELF: forall (u : _), r (f0 (projT1 u) (projT2 u)) (f1 (projT1 u) (projT2 u))
-==========
-forall x y, hyp x y -> paco2 gf r (f0 x y) (f1 x y)
->>
-   5. We decompose the tuple in the coinduction hypothesis
-Goal after step 5:
-<<
-r : rel2 T0 T1
-SELF: forall x y, hyp x y -> r (f0 x y) (f1 x y)
-==========
-forall x y, hyp x y -> paco2 gf r (f0 x y) (f1 x y)
->>
-tODO: Currently this step does not preserve variable names,
-so the actual hypothesis looks more like this:
-<<
-SELF: forall x0 x1, hyp x0 x1 -> r (f0 x0 x1) (f1 x0 x1)
->>
-*)
-Ltac pcofix_ apply_paco_acc0 pack_goal0 unpack_goal0 revert_tmp0 unpack_hyp0 :=
-  hnf;
-  lazymatch goal with
-  | [ |- forall H : ?X, _ ] =>
-    (* 1. *)
-    let H := fresh H in
-    intros H;
-    let pack_goal := (revert H; apply curry_sig; pack_goal0) in
-    let unpack_goal H0 := ltac:(unpack_goal0 H0; destruct H0 as [H H0]; cbn [projT1 projT2]) in
-    let revert_tmp := revert H; revert_tmp0 in
-    let unpack_hyp tmp_self :=
-      intros H;
-      let tmp := fresh tmp_self in
-      rename tmp_self into tmp;
-      assert (tmp_self := fun TMP => tmp (existT _ H TMP));
-      clear tmp;
-      unpack_hyp0 tmp_self in
-    pcofix_ apply_paco_acc0 pack_goal unpack_goal revert_tmp unpack_hyp
-  | _ =>
-    let (* 4 *) unpack_goal _tt :=
-      let tmp_H0 := fresh "_pacotmp_" in
-      intros tmp_H0; unpack_goal0 tmp_H0; clear tmp_H0;
-      revert_tmp0 in
-    let (* 5 *) unpack_hyp HYP :=
-      let tmp_prop := fresh HYP "_prop_" in
-      let tmp_hyp := fresh HYP "_v_" in
-      evar (tmp_prop : Prop); assert (tmp_hyp : tmp_prop); subst tmp_prop;
-        [ unpack_hyp0 HYP; cbn in HYP; exact (HYP tt)
-        | clear HYP ];
-      try rename tmp_hyp into HYP in
-    (* 2. pack_goal *) assert (tmp_H0 := tt); revert tmp_H0; pack_goal0;
-    (* 3. paco_acc *) apply_paco_acc0 unpack_goal unpack_hyp
-  end.
-
-Ltac pcofix_with apply_paco_acc0 :=
-  let pack_goal0 := idtac in
-  let unpack_goal0 _ := idtac in
-  let revert_tmp0 := idtac in
-  let unpack_hyp0 _ := idtac in
-  pcofix_ apply_paco_acc0 pack_goal0 unpack_goal0 revert_tmp0 unpack_hyp0.
-
-Tactic Notation "pcofix" ident(self) :=
-  pcofix_with ltac:(apply_paco_acc self).
diff --git a/theories/Eq/Rutt.v b/theories/Eq/Rutt.v
index c7e7d0f2..45cfb4c5 100644
--- a/theories/Eq/Rutt.v
+++ b/theories/Eq/Rutt.v
@@ -15,26 +15,20 @@
 
 (** [rutt] is used to define the [trace_refine] relation in [ITree.ITrace.ITraceDefinition]. *)
 
-From Coq Require Import
+From Stdlib Require Import
      Morphisms
-.
+     Program.
 
-From ExtLib Require Import
-     Structures.Monad.
+From Coinduction Require Import all.
 
 From ITree Require Import
      Basics.Utils
      Axioms
-     ITree
-     Eq
-     Basics
-.
+     Core.ITreeDefinition
+     Eq.Eqit
+     Eq.Shallow.
 
-From Paco Require Import paco.
-
-Import Monads.
-Import MonadNotation.
-Local Open Scope monad_scope.
+Local Open Scope itree_scope.
 
 Section RuttF.
 
@@ -45,58 +39,58 @@ Section RuttF.
   Contributions to that effect are welcome. *)
   Context (REv : forall (A B : Type), E1 A -> E2 B -> Prop ).
   Context (RAns : forall (A B : Type), E1 A -> A -> E2 B -> B -> Prop ).
-  Context (RR : R1 -> R2 -> Prop).
   Arguments REv {A} {B}.
   Arguments RAns {A} {B}.
 
-  Inductive ruttF (sim : itree E1 R1 -> itree E2 R2 -> Prop) : itree' E1 R1 -> itree' E2 R2 -> Prop :=
+  Inductive ruttF (RR: R1 -> R2 -> Prop) (sim : itree E1 R1 -> itree E2 R2 -> Prop) : itree' E1 R1 -> itree' E2 R2 -> Prop :=
   | EqRet : forall (r1 : R1) (r2 : R2),
       RR r1 r2 ->
-      ruttF sim (RetF r1) (RetF r2)
+      ruttF RR sim (RetF r1) (RetF r2)
   | EqTau : forall (m1 : itree E1 R1) (m2 : itree E2 R2),
       sim m1 m2 ->
-      ruttF sim (TauF m1) (TauF m2)
+      ruttF RR sim (TauF m1) (TauF m2)
   | EqVis : forall (A B : Type) (e1 : E1 A) (e2 : E2 B ) (k1 : A -> itree E1 R1) (k2 : B -> itree E2 R2),
       REv e1 e2 ->
       (forall (a : A) (b : B), RAns e1 a e2 b -> sim (k1 a) (k2 b)) ->
-      ruttF sim (VisF e1 k1) (VisF e2 k2)
+      ruttF RR sim (VisF e1 k1) (VisF e2 k2)
   | EqTauL : forall (t1 : itree E1 R1) (ot2 : itree' E2 R2),
-      ruttF sim (observe t1) ot2 ->
-      ruttF sim (TauF t1) ot2
+      ruttF RR sim (observe t1) ot2 ->
+      ruttF RR sim (TauF t1) ot2
   | EqTauR : forall (ot1 : itree' E1 R1) (t2 : itree E2 R2),
-      ruttF sim ot1 (observe t2) ->
-      ruttF sim ot1 (TauF t2).
+      ruttF RR sim ot1 (observe t2) ->
+      ruttF RR sim ot1 (TauF t2).
   Hint Constructors ruttF : itree.
 
-  Definition rutt_ (sim : itree E1 R1 -> itree E2 R2 -> Prop)
-             (t1 : itree E1 R1) (t2 : itree E2 R2) :=
-    ruttF sim (observe t1) (observe t2).
-  Hint Unfold rutt_ : itree.
+  Definition rutt_ (sim : (R1 -> R2 -> Prop) -> itree E1 R1 -> itree E2 R2 -> Prop) :
+    (R1 -> R2 -> Prop) -> itree E1 R1 -> itree E2 R2 -> Prop :=
+    fun RR t1 t2 =>
+      ruttF RR (sim RR) (observe t1) (observe t2).
 
-  Lemma rutt_monot : monotone2 rutt_.
-  Proof.
-    red. intros. red; induction IN; eauto with itree.
-  Qed.
+  Lemma rutt_mono : Proper (leq ==> leq) rutt_.
+  Proof. monauto. Qed.
 
-  Definition rutt : itree E1 R1 -> itree E2 R2 -> Prop := paco2 rutt_ bot2.
+  Definition rutt_mon : mon ((R1 -> R2 -> Prop) -> itree E1 R1 -> itree E2 R2 -> Prop) :=
+    {| body := rutt_ ; Hbody := rutt_mono |}. 
+
+  Definition rutt : (R1 -> R2 -> Prop) -> itree E1 R1 -> itree E2 R2 -> Prop := gfp rutt_mon.
   Hint Unfold rutt : itree.
 
-  Lemma ruttF_inv_VisF_r {sim} t1 U2 (e2: E2 U2) (k2: U2 -> _):
-    ruttF sim t1 (VisF e2 k2) ->
+  Lemma ruttF_inv_VisF_r {sim} RR t1 U2 (e2: E2 U2) (k2: U2 -> _):
+    ruttF RR sim t1 (VisF e2 k2) ->
     (exists U1 (e1: E1 U1) k1, t1 = VisF e1 k1 /\
       forall v1 v2, RAns e1 v1 e2 v2 -> sim (k1 v1) (k2 v2))
     \/
     (exists t1', t1 = TauF t1' /\
-      ruttF sim (observe t1') (VisF e2 k2)).
+      ruttF RR sim (observe t1') (VisF e2 k2)).
   Proof.
     refine (fun H =>
-      match H in ruttF _ _ t2 return
+      match H in ruttF _ _ _ t2 return
         match t2 return Prop with
         | VisF e2 k2 => _
         | _ => True
         end
       with
-      | EqVis _ _ _ _ _ _ _ _ _ => _
+      | EqVis _ _ _ _ _ _ _ _ _ _ => _
       | _ => _
       end); try exact I.
     - left; eauto.
@@ -104,46 +98,83 @@ Section RuttF.
   Qed.
 
   Lemma ruttF_inv_VisF {sim}
-      U1 U2 (e1 : E1 U1) (e2 : E2 U2) (k1 : U1 -> _) (k2 : U2 -> _)
-    : ruttF sim (VisF e1 k1) (VisF e2 k2) ->
+      RR U1 U2 (e1 : E1 U1) (e2 : E2 U2) (k1 : U1 -> _) (k2 : U2 -> _)
+    : ruttF RR sim (VisF e1 k1) (VisF e2 k2) ->
       forall v1 v2, RAns e1 v1 e2 v2 -> sim (k1 v1) (k2 v2).
   Proof.
     intros H. dependent destruction H. assumption.
   Qed.
 
+End RuttF.
+
+(** ** Rutt-specific tactics *)
 
-  Ltac unfold_rutt :=
-    (try match goal with [|- rutt_ _ _ _ _ _ _ _ ] => red end);
-    (repeat match goal with [H: rutt_ _ _ _ _ _ _ _ |- _ ] => red in H end).
+#[local] Ltac runfold    := unfold rutt.
+#[local] Ltac runfold_in h := unfold rutt in h.
 
-  Lemma fold_ruttF:
-    forall (t1: itree E1 R1) (t2: itree E2 R2) ot1 ot2,
-    ruttF (upaco2 rutt_ bot2) ot1 ot2 ->
-    ot1 = observe t1 ->
-    ot2 = observe t2 ->
-    rutt t1 t2.
-  Proof.
-    intros * eq -> ->; pfold; auto.
-  Qed.
-End RuttF.
+Ltac rcbn := cbn[rutt_mon body]; try unfold rutt_.
+Ltac rcbn_in H := cbn[rutt_mon body] in H; try unfold rutt_ in H.
+
+Tactic Notation "rcbn" "in" ident(h) := rcbn_in h.
+Tactic Notation "rcbn" "in" "*" := cbn[rutt_mon body] in *; try unfold rutt_ in *.
 
-Tactic Notation "fold_ruttF" hyp(H) :=
-  try punfold H;
-  try red in H;
-  match type of H with
-  | ruttF ?_REV ?_RANS ?_RR (upaco2 (rutt_ ?_REV ?_RANS ?_RR) bot2) ?_OT1 ?_OT2 =>
-      match _OT1 with
-      | observe _ => idtac
-      | ?_OT1 => rewrite (itree_eta' _OT1) in H
-      end;
-      match _OT2 with
-      | observe _ => idtac
-      | ?_OT2 => rewrite (itree_eta' _OT2) in H
-      end;
-      eapply fold_ruttF in H; [| eauto | eauto]
+(** [rstep] unfolds [rutt] one step, exposing the [ruttF] functor. *)
+Tactic Notation "rstep" := runfold; step; rcbn.
+Tactic Notation "rstep" "in" ident(h) := runfold_in h; step in h; rcbn in h.
+
+#[local] Ltac refold :=
+  repeat match goal with
+  | |- context[gfp (@rutt_mon ?E1 ?E2 ?R1 ?R2 ?RE ?RA)] =>
+      fold (@rutt E1 E2 R1 R2 RE RA)
   end.
 
-#[global] Hint Resolve rutt_monot : paco.
+Ltac fold_rutt :=
+  match goal with
+  | |- context[@ruttF ?E1 ?E2 ?R1 ?R2 ?REv ?RAns ?RR] =>
+      change (@ruttF E1 E2 R1 R2 REv RAns RR) with (body (@rutt_mon E1 E2 R1 R2 REv RAns RR))
+  end.
+Ltac fold_rutt_in h :=
+  match type of h with
+  | context[@ruttF ?E1 ?E2 ?R1 ?R2 ?REv ?RAns ?RR] =>
+      change (@ruttF E1 E2 R1 R2 REv RAns RR) with (body (@rutt_mon E1 E2 R1 R2 REv RAns RR)) in h
+  end.
+Tactic Notation "runstep" := fold_rutt; unstep.
+Tactic Notation "runstep" "in" ident(h) := fold_rutt_in h; unstep in h.
+
+Ltac to_rmon_core :=
+match goal with
+| |- context[@ruttF ?E1 ?E2 ?R1 ?R2 ?REv ?RAns ?RR (?f ?RR) (observe ?t1) (observe ?t2)] =>
+      change (@ruttF E1 E2 R1 R2 REv RAns RR (f RR) (observe t1) (observe t2))
+      with (@rutt_mon E1 E2 R1 R2 REv RAns f RR t1 t2)
+| |- context[@ruttF ?E1 ?E2 ?R1 ?R2 ?REv ?RAns ?RR (?f ?RR) (?con1 ?a1) (?con2 ?a2)] =>
+      change (@ruttF E1 E2 R1 R2 REv RAns RR (f RR) (con1 a1) (con2 a2))
+      with (@rutt_mon E1 E2 R1 R2 REv RAns f RR (go (con1 a1)) (go (con2 a2)))
+end.
+
+Ltac to_rmon :=
+let dummy := fresh "dummy" in
+assert (dummy : True) by constructor;
+          intros;
+          to_rmon_core;
+          revert_until dummy;
+          clear dummy.
+
+Ltac to_rmon_in h :=
+match type of h with
+| context[@ruttF ?E1 ?E2 ?R1 ?R2 ?REv ?RAns ?RR (?f ?RR) (observe ?t1) (observe ?t2)] =>
+      change (@ruttF E1 E2 R1 R2 REv RAns RR (f RR) (observe t1) (observe t2))
+      with (@rutt_mon E1 E2 R1 R2 REv RAns f RR t1 t2) in h
+| context[@ruttF ?E1 ?E2 ?R1 ?R2 ?REv ?RAns ?RR (?f ?RR) (?con1 ?a1) (?con2 ?a2)] =>
+      change (@ruttF E1 E2 R1 R2 REv RAns RR (f RR) (con1 a1) (con2 a2))
+      with (@rutt_mon E1 E2 R1 R2 REv RAns f RR (go (con1 a1)) (go (con2 a2))) in h
+end.
+
+Tactic Notation "to_rmon" "in" ident(h) := to_rmon_in h.
+
+#[global] Hint Constructors ruttF : itree.
+#[global] Hint Unfold rutt_ : itree.
+#[global] Hint Unfold rutt_mon : itree.
+#[global] Hint Unfold rutt : itree.
 
 Section ConstructionInversion.
 Variables (E1 E2: Type -> Type).
@@ -155,19 +186,19 @@ Variable (RR: R1 -> R2 -> Prop).
 Lemma rutt_Ret r1 r2:
   RR r1 r2 ->
   @rutt E1 E2 R1 R2 REv RAns RR (Ret r1: itree E1 R1) (Ret r2: itree E2 R2).
-Proof. intros. pstep; constructor; auto. Qed.
+Proof. intros. rstep. constructor; auto. Qed.
 
 Lemma rutt_inv_Ret r1 r2:
   rutt REv RAns RR (Ret r1) (Ret r2) -> RR r1 r2.
 Proof.
-  intros. punfold H. inv H. eauto.
+  intros. rstep in H. inv H.
 Qed.
 
 Lemma rutt_inv_Ret_l r1 t2:
   rutt REv RAns RR (Ret r1) t2 -> exists r2, t2 ≳ Ret r2 /\ RR r1 r2.
 Proof.
-  intros Hrutt; punfold Hrutt; red in Hrutt; cbn in Hrutt.
-  setoid_rewrite (itree_eta t2). remember (RetF r1) as ot1; revert Heqot1.
+  intros Hrutt. rstep in Hrutt. rcbn in Hrutt. 
+  setoid_rewrite (itree_eta t2). remember (observe (Ret r1)) as ot1; revert Heqot1.  
   induction Hrutt; intros; try discriminate.
   - inversion Heqot1; subst. exists r2. split; [reflexivity|auto].
   - destruct (IHHrutt Heqot1) as [r2 [H1 H2]]. exists r2; split; auto.
@@ -177,45 +208,62 @@ Qed.
 Lemma rutt_inv_Ret_r t1 r2:
   rutt REv RAns RR t1 (Ret r2) -> exists r1, t1 ≳ Ret r1 /\ RR r1 r2.
 Proof.
-  intros Hrutt; punfold Hrutt; red in Hrutt; cbn in Hrutt.
-  setoid_rewrite (itree_eta t1). remember (RetF r2) as ot2; revert Heqot2.
+  intros Hrutt. rstep in Hrutt. rcbn in Hrutt.
+  setoid_rewrite (itree_eta t1). remember (observe (Ret r2)) as ot2; revert Heqot2.
   induction Hrutt; intros; try discriminate.
   - inversion Heqot2; subst. exists r1. split; [reflexivity|auto].
   - destruct (IHHrutt Heqot2) as [r1 [H1 H2]]. exists r1; split; auto.
     rewrite <- itree_eta in H1. now rewrite tau_euttge.
 Qed.
 
+(** Helper: inversion of [ruttF] at [TauF] on the left. *)
+Lemma ruttF_inv_tau_l t1 ot2 :
+  ruttF REv RAns RR (rutt REv RAns RR) (TauF t1) ot2 ->
+  ruttF REv RAns RR (rutt REv RAns RR) (observe t1) ot2.
+Proof.
+  intros H. remember (TauF t1) as tt1.
+  induction H; try discriminate.
+  - inv Heqtt1. constructor. rstep in H. exact H.
+  - inv Heqtt1.
+  - constructor. auto.
+Qed.
+
+(** Helper: inversion of [ruttF] at [TauF] on the right. *)
+Lemma ruttF_inv_tau_r ot1 t2 :
+  ruttF REv RAns RR (rutt REv RAns RR) ot1 (TauF t2) ->
+  ruttF REv RAns RR (rutt REv RAns RR) ot1 (observe t2).
+Proof.
+  intros H. remember (TauF t2) as tt2.
+  induction H; try discriminate.
+  - inv Heqtt2. constructor. rstep in H. exact H.
+  - constructor. auto.
+  - inv Heqtt2.
+Qed.
+
 Lemma rutt_inv_Tau_l t1 t2 :
   rutt REv RAns RR (Tau t1) t2 -> rutt REv RAns RR t1 t2.
 Proof.
-  intros. punfold H. red in H. simpl in *.
-  remember (TauF t1) as tt1. genobs t2 ot2.
-  hinduction H before t1; intros; try discriminate.
-  - inv Heqtt1. pclearbot. pstep. red. simpobs. econstructor; eauto. pstep_reverse.
-  - inv Heqtt1. punfold_reverse H.
-  - red in IHruttF. pstep. red; simpobs. econstructor; eauto. pstep_reverse.
+  intros. rstep in H. rstep.
+  apply ruttF_inv_tau_l. exact H.
 Qed.
 
 Lemma rutt_add_Tau_l t1 t2 :
   rutt REv RAns RR t1 t2 -> rutt REv RAns RR (Tau t1) t2.
 Proof.
-  intros. pfold. red. cbn. constructor. pstep_reverse.
+  intros. rstep. constructor. rstep in H. exact H.
 Qed.
 
 Lemma rutt_inv_Tau_r t1 t2 :
   rutt REv RAns RR t1 (Tau t2) -> rutt REv RAns RR t1 t2.
 Proof.
-  intros. punfold H. red in H. simpl in *.
-  pstep. red. remember (TauF t2) as tt2 eqn:Ett2 in H.
-  revert t2 Ett2; induction H; try discriminate; intros; inversion Ett2; subst; auto.
-  - pclearbot. constructor. pstep_reverse.
-  - constructor. eapply IHruttF; eauto.
+  intros. rstep in H. rstep.
+  apply ruttF_inv_tau_r. exact H.
 Qed.
 
 Lemma rutt_add_Tau_r t1 t2 :
   rutt REv RAns RR t1 t2 -> rutt REv RAns RR t1 (Tau t2).
 Proof.
-  intros. pfold. red. cbn. constructor. pstep_reverse.
+  intros. rstep. constructor. rstep in H. exact H.
 Qed.
 
 Lemma rutt_inv_Tau t1 t2 :
@@ -230,8 +278,7 @@ Lemma rutt_Vis {T1 T2} (e1: E1 T1) (e2: E2 T2)
   (forall t1 t2, RAns _ _ e1 t1 e2 t2 -> rutt REv RAns RR (k1 t1) (k2 t2)) ->
   rutt REv RAns RR (Vis e1 k1) (Vis e2 k2).
 Proof.
-  intros He Hk. pstep; constructor; auto.
-  intros; left. apply Hk; auto.
+  intros He Hk. rstep. constructor; auto.
 Qed.
 
 Lemma rutt_inv_Vis_l {U1} (e1: E1 U1) k1 t2:
@@ -241,13 +288,12 @@ Lemma rutt_inv_Vis_l {U1} (e1: E1 U1) k1 t2:
     REv _ _ e1 e2 /\
     (forall v1 v2, RAns _ _ e1 v1 e2 v2 -> rutt REv RAns RR (k1 v1) (k2 v2)).
 Proof.
-  intros Hrutt; punfold Hrutt; red in Hrutt; cbn in Hrutt.
-  setoid_rewrite (itree_eta t2). remember (VisF e1 k1) as ot1; revert Heqot1.
+  intros Hrutt. rstep in Hrutt. rcbn in Hrutt.
+  setoid_rewrite (itree_eta t2). remember (observe (Vis e1 k1)) as ot1; revert Heqot1.
   induction Hrutt; intros; try discriminate; subst.
   - inversion Heqot1; subst A. inversion_sigma; rewrite <- eq_rect_eq in *;
     subst; rename B into U2.
     exists U2, e2, k2; split. reflexivity. split; auto.
-    intros v1 v2 HAns. specialize (H0 v1 v2 HAns). red in H0. now pclearbot.
   - destruct (IHHrutt eq_refl) as (U2 & e2 & k2 & Ht0 & HAns).
     rewrite <- itree_eta in Ht0.
     exists U2, e2, k2; split; auto. now rewrite tau_eutt.
@@ -260,13 +306,12 @@ Lemma rutt_inv_Vis_r {U2} t1 (e2: E2 U2) k2:
     REv U1 U2 e1 e2 /\
     (forall v1 v2, RAns _ _ e1 v1 e2 v2 -> rutt REv RAns RR (k1 v1) (k2 v2)).
 Proof.
-  intros Hrutt; punfold Hrutt; red in Hrutt; cbn in Hrutt.
-  setoid_rewrite (itree_eta t1). remember (VisF e2 k2) as ot2; revert Heqot2.
+  intros Hrutt. rstep in Hrutt. rcbn in Hrutt.
+  setoid_rewrite (itree_eta t1). remember (observe (Vis e2 k2)) as ot2; revert Heqot2.
   induction Hrutt; intros; try discriminate; subst.
   - inversion Heqot2; subst B. inversion_sigma; rewrite <- eq_rect_eq in *;
     subst; rename A into U1.
     exists U1, e1, k1; split. reflexivity. split; auto.
-    intros v1 v2 HAns. specialize (H0 v1 v2 HAns). red in H0. now pclearbot.
   - destruct (IHHrutt eq_refl) as (U1 & e1 & k1 & Ht0 & HAns).
     rewrite <- itree_eta in Ht0.
     exists U1, e1, k1; split; auto. now rewrite tau_eutt.
@@ -277,124 +322,8 @@ Lemma rutt_inv_Vis U1 U2 (e1: E1 U1) (e2: E2 U2)
   rutt REv RAns RR (Vis e1 k1) (Vis e2 k2) ->
   forall u1 u2, RAns U1 U2 e1 u1 e2 u2 -> rutt REv RAns RR (k1 u1) (k2 u2).
 Proof.
-  intros H u1 u2 Hans. punfold H.
-  apply ruttF_inv_VisF with (v1 := u1) (v2 := u2) in H. pclearbot; auto.
-  assumption.
-Qed.
-End ConstructionInversion.
-
-Section euttge_trans_clo.
-
-  Context {E1 E2 : Type -> Type} {R1 R2 : Type} (RR : R1 -> R2 -> Prop).
-
-  (* Closing a relation over itrees under [euttge].
-     Essentially the same closure as [eqit_trans_clo], but heterogeneous
-     in the interface argument [E].
-     We only define the closure under [euttge] as opposed to [eqit_trans_clo]
-     capturing closure under [eq_itree] and [eutt] at the same time, since it's
-     the only one we need.
-   *)
-
-  (* A transitivity functor *)
-  Variant euttge_trans_clo (r : itree E1 R1 -> itree E2 R2 -> Prop) :
-    itree E1 R1 -> itree E2 R2 -> Prop :=
-    eqit_trans_clo_intro t1 t2 t1' t2' RR1 RR2
-                         (EQVl: euttge RR1 t1 t1')
-                         (EQVr: euttge RR2 t2 t2')
-                         (REL: r t1' t2')
-                         (LERR1: forall x x' y, RR1 x x' -> RR x' y -> RR x y)
-                         (LERR2: forall x y y', RR2 y y' -> RR x y' -> RR x y) :
-      euttge_trans_clo r t1 t2.
-  Hint Constructors euttge_trans_clo : itree.
-
-  Lemma euttge_trans_clo_mon r1 r2 t1 t2
-        (IN : euttge_trans_clo r1 t1 t2)
-        (LE : r1 <2= r2) :
-    euttge_trans_clo r2 t1 t2.
-  Proof.
-    destruct IN; econstructor; eauto.
-  Qed.
-
-  Hint Resolve euttge_trans_clo_mon : paco.
-
-End euttge_trans_clo.
-
-(*replicate this proof for the models functor*)
-(* Validity of the up-to [euttge] principle *)
-Lemma euttge_trans_clo_wcompat E1 E2 R1 R2 (REv : forall A B, E1 A -> E2 B -> Prop)
-      (RAns : forall A B, E1 A -> A -> E2 B -> B -> Prop ) (RR : R1 -> R2 -> Prop) :
-  wcompatible2 (rutt_ REv RAns RR) (euttge_trans_clo RR).
-Proof.
-  constructor; eauto with paco.
-  { red. intros. eapply euttge_trans_clo_mon; eauto. }
-  intros.
-  destruct PR. punfold EQVl. punfold EQVr. unfold_eqit.
-  hinduction REL before r; intros; clear t1' t2'.
-  - remember (RetF r1) as x. red.
-    hinduction EQVl before r; intros; subst; try inv Heqx; eauto; (try constructor; eauto).
-    remember (RetF r3) as x. hinduction EQVr before r; intros; subst; try inv Heqx; (try constructor; eauto).
-  - red. remember (TauF m1) as x.
-    hinduction EQVl before r; intros; subst; try inv Heqx; try inv CHECK; ( try (constructor; eauto; fail )).
-    remember (TauF m3) as y.
-    hinduction EQVr before r; intros; subst; try inv Heqy; try inv CHECK; (try (constructor; eauto; fail)).
-    pclearbot. constructor. gclo. econstructor; eauto with paco.
-  - remember (VisF e1 k1) as x. red.
-    hinduction EQVl before r; intros; subst; try discriminate; try (constructor; eauto; fail).
-    remember (VisF e2 k3) as y.
-    hinduction EQVr before r; intros; subst; try discriminate; try (constructor; eauto; fail).
-    dependent destruction Heqx.
-    dependent destruction Heqy.
-    constructor; auto. intros. apply H0 in H1. pclearbot.
-    apply gpaco2_clo.
-    econstructor; eauto with itree.
-  - remember (TauF t1) as x. red.
-    hinduction EQVl before r; intros; subst; try inv Heqx; try inv CHECK; (try (constructor; eauto; fail)).
-    pclearbot. punfold REL. constructor. eapply IHREL; eauto.
-  - remember (TauF t2) as y. red.
-    hinduction EQVr before r; intros; subst; try inv Heqy; try inv CHECK; (try (constructor; eauto; fail)).
-    pclearbot. punfold REL. constructor. eapply IHREL; eauto.
-Qed.
-
-#[global] Hint Resolve euttge_trans_clo_wcompat : paco.
-
-(* The validity of the up-to [euttge] entails we can rewrite under [euttge]
-   and hence also [eq_itree] during coinductive proofs of [rutt]
-*)
-#[global] Instance grutt_cong_eqit {R1 R2 : Type} {E1 E2 : Type -> Type} {REv : forall A B, E1 A -> E2 B -> Prop}
-       {RAns : forall A B, E1 A -> A -> E2 B -> B -> Prop} {RR1 RR2} {RS : R1 -> R2 -> Prop} r rg
-       (LERR1: forall x x' y, (RR1 x x': Prop) -> (RS x' y: Prop) -> RS x y)
-       (LERR2: forall x y y', (RR2 y y': Prop) -> RS x y' -> RS x y) :
-  Proper (eq_itree RR1 ==> eq_itree RR2 ==> flip impl)
-         (gpaco2 (rutt_ REv RAns RS) (euttge_trans_clo RS) r rg).
-Proof.
-  repeat intro. gclo. econstructor; eauto;
-    try eapply eqit_mon; try apply H; try apply H0; auto.
+  intros H u1 u2 Hans. rstep in H.
+  exact (ruttF_inv_VisF _ _ _ _ _ _ _ _ _ H u1 u2 Hans).
 Qed.
 
-Global Instance grutt_cong_euttge {R1 R2 : Type} {E1 E2 : Type -> Type} {REv : forall A B, E1 A -> E2 B -> Prop}
-       {RAns : forall A B, E1 A -> A -> E2 B -> B -> Prop} {RR1 RR2} {RS : R1 -> R2 -> Prop} r rg
-       (LERR1: forall x x' y, (RR1 x x': Prop) -> (RS x' y: Prop) -> RS x y)
-       (LERR2: forall x y y', (RR2 y y': Prop) -> RS x y' -> RS x y) :
-  Proper (euttge RR1 ==> euttge RR2 ==> flip impl)
-         (gpaco2 (rutt_ REv RAns RS) (euttge_trans_clo RS) r rg).
-Proof.
-  repeat intro. gclo. econstructor; eauto.
-Qed.
-
-(* Provide these explicitly since typeclasses eauto cannot infer them *)
-
-#[global] Instance grutt_cong_eqit_eq {R1 R2 : Type} {E1 E2 : Type -> Type} {REv : forall A B, E1 A -> E2 B -> Prop}
-      {RAns : forall A B, E1 A -> A -> E2 B -> B -> Prop} {RS : R1 -> R2 -> Prop} r rg:
-    Proper (eq_itree eq ==> eq_itree eq ==> flip impl)
-         (gpaco2 (rutt_ REv RAns RS) (euttge_trans_clo RS) r rg).
-Proof.
-  apply grutt_cong_eqit; now intros * ->.
-Qed.
-
-#[global] Instance grutt_cong_euttge_eq {R1 R2 : Type} {E1 E2 : Type -> Type} {REv : forall A B, E1 A -> E2 B -> Prop}
-      {RAns : forall A B, E1 A -> A -> E2 B -> B -> Prop} {RS : R1 -> R2 -> Prop} r rg:
-    Proper (euttge eq ==> euttge eq ==> flip impl)
-         (gpaco2 (rutt_ REv RAns RS) (euttge_trans_clo RS) r rg).
-Proof.
-  apply grutt_cong_euttge; now intros * ->.
-Qed.
+End ConstructionInversion.
\ No newline at end of file
diff --git a/theories/Eq/RuttFacts.v b/theories/Eq/RuttFacts.v
index 0540170b..945e9607 100644
--- a/theories/Eq/RuttFacts.v
+++ b/theories/Eq/RuttFacts.v
@@ -7,15 +7,15 @@
 (** The main additions in this file are compatibility with [eutt], morphisms
   wrt. [REv] and [RAns], and an up-to principle. *)
 
-From Coq Require Import
+(* begin hide *)
+From Coinduction Require Import all. 
+
+From Stdlib Require Import
   Program
   Setoid
   Morphisms
   RelationClasses.
 
-From Paco Require Import
-  paco.
-
 From ITree Require Import
   ITree
   ITreeFacts
@@ -24,6 +24,8 @@ From ITree Require Import
   Eq.Rutt
   Props.Leaf.
 
+(* end hide *)
+
 (* Extra construction lemmas *)
 
 Lemma rutt_trigger {E1 E2 R1 R2 REv RAns RR} (e1: E1 R1) (e2: E2 R2):
@@ -98,16 +100,16 @@ Proof. reflexivity. Qed.
 Lemma rutt_flip {E1 E2 R1 R2 REv RAns RR} (t1: itree E1 R1) (t2: itree E2 R2):
   rutt REv RAns RR t1 t2 <-> rutt (flip_REv REv) (flip_RAns RAns) (flip RR) t2 t1.
 Proof.
-  split; revert t1 t2; pcofix CIH; intros t1 t2 Hrutt;
-  punfold Hrutt; red in Hrutt; pstep; red.
+  split; revert t1 t2; coinduction c CIH; icbn; intros t1 t2 Hrutt; 
+  step in Hrutt.
   - induction Hrutt; try now constructor.
-    * apply EqTau. right. apply CIH. now pclearbot.
-    * apply EqVis. auto. intros b a HAns. cbn in HAns. right.
-      specialize (H0 a b HAns). apply CIH. now pclearbot.
+    * apply EqTau. now apply CIH.
+    * apply EqVis. auto. intros b a HAns. cbn in HAns.
+      specialize (H0 a b HAns). now apply CIH.
   - induction Hrutt; try now constructor.
-    * apply EqTau. right. apply CIH. now pclearbot.
-    * apply EqVis. auto. intros b a HAns. cbn in HAns. right.
-      specialize (H0 a b HAns). apply CIH. now pclearbot.
+    * apply EqTau. now apply CIH.
+    * apply EqVis. auto. intros b a HAns. cbn in HAns.
+      specialize (H0 a b HAns). now apply CIH.
 Qed.
 
 (* Progressive [Proper] instances for [rutt] and congruence with eutt. *)
@@ -121,29 +123,55 @@ Qed.
       ==> iff) (@rutt E1 E2 R1 R2).
 Proof.
   intros REv1 REv2 HREv  RAns1 RAns2 HRAns RR1 RR2 HRR t1 _ <- t2 _ <-.
-  split; intros Hrutt.
-
-  - revert t1 t2 Hrutt; pcofix CIH; intros t1 t2 Hrutt.
-    pstep. punfold Hrutt. red in Hrutt; red.
+  split; intros Hrutt; 
+    revert t1 t2 Hrutt; coinduction c CIH; intros t1 t2 Hrutt; 
+    step in Hrutt; rcbn; 
     hinduction Hrutt before CIH; intros; eauto using EqTauL, EqTauR.
-    * apply EqRet. now apply HRR.
-    * apply EqTau. right. apply CIH. now pclearbot.
+    1,4: apply EqRet; now apply HRR. 
+    1,3: apply EqTau; now apply CIH.
     * apply EqVis. now apply HREv. intros.
       assert (H2: RAns1 A B e1 a e2 b).
       { erewrite <- eq_RAns_iff. apply H1. assumption. }
-      intros. specialize (H0 a b H2). red. right. apply CIH.
-      red in H0. now pclearbot.
-
-  - revert t1 t2 Hrutt; pcofix CIH; intros t1 t2 Hrutt.
-    pstep. punfold Hrutt. red in Hrutt; red.
-    hinduction Hrutt before CIH; intros; eauto using EqTauL, EqTauR.
-    * apply EqRet. now apply HRR.
-    * apply EqTau. right. apply CIH. now pclearbot.
+      intros. specialize (H0 a b H2). now apply CIH.
     * apply EqVis. now apply HREv. intros.
       assert (H2: RAns2 A B e1 a e2 b).
       { erewrite eq_RAns_iff. apply H1. assumption. }
-      intros. specialize (H0 a b H2). red. right. apply CIH.
-      red in H0. now pclearbot.
+      intros. specialize (H0 a b H2). now apply CIH.
+Qed.
+
+#[global] Instance eq_proper_ruttC {E1 E2 R1 R2 REv RAns}
+  (RR : R1 -> R2 -> Prop) (c : Chain (@rutt_mon E1 E2 R1 R2 REv RAns)):
+  Proper (eq_itree eq ==> eq_itree eq ==> iff) (elem c RR).
+Proof.
+  split; revert_until c; tower induction;
+  intros IH t1 t1' Ht1 t2 t2' Ht2;
+  step in Ht1; step in Ht2; rcbn; intros Hrutt;
+  genobs t1' ot1'; genobs t2' ot2';
+  move Hrutt before IH; revert_until Hrutt;
+  induction Hrutt; intros; subst.
+  1-3,6-8: inv Ht1; inv Ht2; simpobs; try now constructor.
+  + simpobs. constructor. eapply IH; eauto.
+  + simpobs.
+    dependent destruction H3; dependent destruction H4;
+    dependent destruction H6; dependent destruction H7.
+    constructor; auto. intros. eapply IH. apply REL. apply REL0. now apply H0.
+  + simpobs. constructor. eapply IH; eauto.
+  + simpobs.
+    dependent destruction H4; dependent destruction H5;
+    dependent destruction H7; dependent destruction H8.
+    constructor; auto. intros. eapply IH. apply REL. apply REL0. now apply H0.
+  + inv Ht1. constructor. eapply IHHrutt; eauto. now unstep.
+  + inv Ht2. constructor. eapply IHHrutt; eauto. now unstep.
+  + inv Ht1. constructor. eapply IHHrutt; eauto. now unstep.
+  + inv Ht2. constructor. eapply IHHrutt; eauto. now unstep.
+Qed.
+
+#[global] Instance eq_proper_rutt {E1 E2 R1 R2 REv RAns}
+  (RR : R1 -> R2 -> Prop):
+  Proper (eq_itree eq ==> eq_itree eq ==> iff) (@rutt E1 E2 R1 R2 REv RAns RR).
+Proof.
+  unfold rutt. intros t1 t1' Ht1 t2 t2' Ht2.
+  apply eq_proper_ruttC; auto.
 Qed.
 
 #[global] Instance rutt_Proper_R2 {E1 E2 R1 R2}:
@@ -154,22 +182,80 @@ Qed.
       ==> eq_itree eq    (* t2 *)
       ==> iff) (@rutt E1 E2 R1 R2).
 Proof.
-  clear. intros REv1 REv2 HREv RAns1 RAns2 HRAns RR1 RR2 HRR t1 t1' Ht1 t2 t2' Ht2.
-  split; intros Hrutt.
+  intros REv1 REv2 HREv RAns1 RAns2 HRAns RR1 RR2 HRR t1 t1' Ht1 t2 t2' Ht2.
+  rewrite Ht1, Ht2. apply rutt_Proper_R; auto.
+Qed.
+
+#[global] Instance euttge_proper_ruttC {E1 E2 R1 R2 REv RAns}
+  (RR : R1 -> R2 -> Prop) (c : Chain (@rutt_mon E1 E2 R1 R2 REv RAns)):
+  Proper (euttge eq ==> euttge eq ==> flip impl) (elem c RR).
+Proof.
+  unfold Proper, respectful, flip, impl.
+  tower induction.
+  intros IH x x' EQx y y' EQy; step in EQx; step in EQy.
+  rcbn; intros EQ.
+  genobs x' ox'; genobs y' oy'.
+  revert x x' y y' Heqox' Heqoy' EQx EQy.
+  induction EQ; intros.
+
+  (* EqRet *)
+  - clear x' y' Heqox' Heqoy'.
+    genobs x ox. genret r1 or1. revert x Heqox.
+    hinduction EQx before ox; try easy.
+    + intros; subst; inv Heqor1. clear x Heqox.
+      genobs y oy. genret r2 or2. revert y Heqoy.
+      hinduction EQy before oy; try easy.
+      * subst; intros [=<-] ? ?. constructor. auto.
+      * intros. apply EqTauR; auto. eapply IHEQy; eauto.
+    + intros; subst. apply EqTauL; auto. eapply IHEQx; eauto.
+
+  (* EqTau *)
+  - clear x' y' Heqox' Heqoy'.
+    genobs x ox. gentau m1 om1. revert x Heqox.
+    hinduction EQx before ox; try easy.
+    + intros [=<-] ? ?.
+      genobs y oy. gentau m2 om2. revert y Heqoy.
+      hinduction EQy before oy; try easy.
+      * intros [=<-] ? ?. to_rmon_core. intros ? ?. rcbn. constructor. eapply IH; eauto.
+      * intros. apply EqTauR; auto. eapply IHEQy; eauto.
+    + intros; subst. apply EqTauL; auto. eapply IHEQx; eauto.
+
+  (* EqVis *)
+  - clear x' y' Heqox' Heqoy'.
+    genobs x ox. genvis e1 k1 ot1. revert x Heqox.
+    hinduction EQx before ox; try easy.
+    + intros. apply eq_inv_VisF_weak in Heqot1 as (-> & ? & ?); cbn in *; subst.
+      clear x Heqox.
+      genobs y oy. genvis e2 k2 ot2. revert y Heqoy.
+      hinduction EQy before oy; try easy.
+      * intros. apply eq_inv_VisF_weak in Heqot2 as (-> & ? & ?); cbn in *; subst.
+        constructor; auto. intros. eapply IH. apply (REL a). apply (REL0 b). apply H0; auto.
+      * intros. apply EqTauR; auto. eapply IHEQy; eauto.
+    + intros; subst. apply EqTauL; auto. eapply IHEQx; eauto.
+
+  (* EqTauL *)
+  - edestruct euttge_tau_r_inv; [step; eauto |].
+    simpobs.
+    apply EqTauL; auto.
+    eapply IHEQ; eauto.
+    assert (euttge eq (Tau x0) (Tau t1)) by (now step).
+    unstep; eapply euttge_tau_inv; eauto.
+
+  (* EqTauR *)
+  - edestruct euttge_tau_r_inv; [step; eauto |].
+    simpobs.
+    apply EqTauR; auto.
+    eapply IHEQ; eauto.
+    assert (euttge eq (Tau x0) (Tau t2)) by (now step).
+    unstep; eapply euttge_tau_inv; eauto.
+Qed.
 
-  - rewrite <- HREv, <- HRAns, <- HRR; clear HREv REv2 HRAns RAns2 HRR RR2.
-    ginit. gclo. econstructor; eauto with paco.
-    * symmetry in Ht1. apply eq_sub_euttge in Ht1. apply Ht1.
-    * symmetry in Ht2. apply eq_sub_euttge in Ht2. apply Ht2.
-    * intros; now subst.
-    * intros; now subst.
-
-  - rewrite HREv, HRAns, HRR; clear HREv REv1 HRAns RAns1 HRR RR1.
-    ginit. gclo. econstructor; eauto with paco.
-    * apply eq_sub_euttge in Ht1. apply Ht1.
-    * apply eq_sub_euttge in Ht2. apply Ht2.
-    * intros; now subst.
-    * intros; now subst.
+#[global] Instance euttge_proper_rutt {E1 E2 R1 R2 REv RAns}
+  (RR : R1 -> R2 -> Prop):
+  Proper (euttge eq ==> euttge eq ==> flip impl) (@rutt E1 E2 R1 R2 REv RAns RR).
+Proof.
+  unfold rutt. intros t1 t1' Ht1 t2 t2' Ht2.
+  apply euttge_proper_ruttC; auto.
 Qed.
 
 Lemma rutt_cong_eutt {E1 E2 R1 R2}:
@@ -178,77 +264,89 @@ Lemma rutt_cong_eutt {E1 E2 R1 R2}:
   t1 ≈ t1' ->
   rutt REv RAns RR t1' t2.
 Proof.
-  (* First by coinduction; then do an induction on Hrutt to expose the ruttF
-     linking t1 and t2; then an induction on Heutt to expose the relation
-     between t1 and t1'. Finally, explore ruttF until landing on an rutt where
-     the t1/t1' relation can be substituted by CIH, and conclude. *)
   intros * Hrutt Heutt; revert t1 t1' Heutt t2 Hrutt.
-  ginit; gcofix CIH; intros t1 t1' Heutt t2 Hrutt.
-  punfold Hrutt; red in Hrutt.
-  rewrite (itree_eta t1) in Heutt.
-  rewrite (itree_eta t2).
-
+  coinduction c CIH; icbn; intros t1 t1' Heutt t2 Hrutt.
+  step in Hrutt.
+  rewrite (itree_eta t1') in Heutt.
+  remember (observe t1) as ot1 eqn:Hot1.
+  remember (observe t2) as ot2 eqn:Hot2.
   move Hrutt before CIH; revert_until Hrutt.
-  induction Hrutt as [r1 r2|m1 m2| |m1 ot2|]; clear t1 t2; intros t1' Heutt.
-
-  (* EqRet: t1 = Ret r1 ≈ t1'; we can rewrite away the Taus with the euttge
-     closure and finish immediately with EqRet. *)
-  * apply eutt_inv_Ret_l in Heutt. rewrite Heutt.
-    gfinal; right; pstep. now apply EqRet.
-
-  (* EqTau: The hardest case. When Heutt is EqTauL then we lack information to
-     proceed, which requires that [desobs m1]. We then have to restart
-     analyzing based on m1; the Ret case repeats EqRet above, while the Vis
-     case repeats EqVis below. *)
-  * punfold Heutt; red in Heutt; cbn in Heutt.
-    rewrite itree_eta. pclearbot. fold_ruttF H.
-    remember (TauF m1) as ot1; revert m1 m2 H Heqot1.
-    induction Heutt as [|m1_bis m1'| |m1_bis ot1' _|t1_bis m1'];
-    intros * Hrutt Heqot1; clear t1'; try discriminate.
-    + inv Heqot1. pclearbot. gfinal; right; pstep; red.
-      apply EqTau. right. now apply (CIH m1).
-    + inv Heqot1. rewrite (itree_eta m1) in Hrutt.
-      desobs m1 Hm1; clear m1 Hm1.
-      { fold_eqitF Heutt. apply eutt_inv_Ret_l in Heutt.
-        rewrite Heutt, tau_euttge. gfinal; right. eapply paco2_mon_bot; eauto. }
-      { apply rutt_inv_Tau_l in Hrutt. eapply IHHeutt; eauto. }
-      { clear IHHeutt. remember (VisF e k) as m1; revert Heqm1.
-        induction Heutt as [| |U1 e1 k1 k1' Hk1k1'| |]; intros; try discriminate.
-        - symmetry in Heqm1; dependent destruction Heqm1.
-          rewrite tau_euttge, (itree_eta m2).
-          punfold Hrutt; red in Hrutt; cbn in Hrutt.
-          remember (VisF e1 k1) as m1; revert Heqm1.
-          induction Hrutt; intros; try discriminate.
-          * dependent destruction Heqm1.
-            gfinal; right. pstep; red; cbn.
-            apply EqVis; auto. intros v1 v2 HAns. specialize (H0 v1 v2 HAns).
-            hnf in H0; hnf. pclearbot; right. apply (CIH (k1 v1)); auto.
-            apply Hk1k1'.
-          * idtac. rewrite tau_euttge, (itree_eta t2). now apply IHHrutt.
-        - idtac. rewrite tau_euttge, itree_eta; now apply IHHeutt. }
-    + inv Heqot1. gfinal; right. pstep; red. apply EqTau. right.
-      fold_eqitF Heutt. rewrite tau_euttge in Heutt. now apply (CIH m1).
-
-  (* EqVis: Similar to EqRet, but we don't have t1' ≳ Vis e1 k1 because the
-     continuations are "only" ≈. The up-to-eutt principle that enforces Vis
-     steps could work, but we don't have it for rutt. Instead we peel the Tau
-     layers off t1' with a manual induction. *)
-  * rewrite itree_eta. gfinal; right; pstep.
-    rename H0 into HAns. punfold Heutt; red in Heutt; cbn in Heutt.
-    remember (VisF e1 k1) as m1; revert Heqm1.
-    induction Heutt; intros; try discriminate.
-    + dependent destruction Heqm1.
-      apply EqVis; auto. intros a b HAns'. specialize (HAns a b HAns').
-      hnf in HAns; hnf. pclearbot; right. apply (CIH (k1 a)); auto. apply REL.
-    + now apply EqTauL, IHHeutt.
-
-  (* EqTauL: We get a very strong IHHrutt at the ruttF level, which we can
-     apply immediately; then handle the added Tau in ≈, which is trivial. *)
-  * apply IHHrutt. rewrite <- itree_eta. now rewrite <- tau_eutt.
-
-  (* EqTauR: Adding a Tau on the side of t2 changes absolutely nothing to the
-     way we rewrite t1, so we can follow down and recurse. *)
-  * rewrite tau_euttge. rewrite (itree_eta t0). now apply IHHrutt.
+  induction Hrutt as [r1 r2|m1 m2| |m1 ot2'|]; intros tt1 tt1' Heutt' tt2 Hot1' Hot2'.
+  - (* EqRet *)
+    step in Heutt'. cbn in Heutt'.
+    rewrite <- Hot1' in Heutt'. clear Hot1' Hot2' tt1 tt2.
+    remember (RetF r1) as oRetL eqn:HoRetL.
+    induction Heutt'; try discriminate.
+    + inv HoRetL. now constructor.
+    + apply EqTauL. now apply IHHeutt'.
+  - (* EqTau *)
+    step in Heutt'. cbn in Heutt'.
+    rewrite <- Hot1' in Heutt'. clear tt1 Hot1'.
+    clear tt2 Hot2'.
+    step in H. rcbn in H.
+    remember (TauF m1) as oTauL eqn:HoTauL.
+    revert m1 m2 H HoTauL.
+    induction Heutt' as [r1 r2 _|m1' m1''|U' e1 k1 k1' _|t1' ot1' _ IHHeutt'|t1'' m1''];
+      intros m1 m2 H HoTauL; try discriminate.
+    + (* EqTau of Heutt' *)
+      inv HoTauL. apply EqTau. apply CIH with m1.
+      * apply REL.
+      * unfold rutt. step. exact H.
+    + (* EqTauL of Heutt': need to case on the head of m1 *)
+      inv HoTauL.
+      destruct (observe m1) as [r1|m1_body|U1 e1 k1] eqn:Hobs_m1.
+      * (* m1 = Ret r1 *)
+        remember (RetF r1) as oRetL eqn:HoRetL.
+        clear Hobs_m1 m1 IHIHHeutt'.
+        revert H.
+        induction IHHeutt'; try discriminate; intros.
+        ** inv HoRetL.
+           apply EqTauR.
+           remember (RetF r1) as oRetL2 eqn:HoRetL2.
+           induction H; try discriminate.
+           *** inv HoRetL2. constructor. now subst.
+           *** apply EqTauR. now apply IHruttF.
+        ** apply EqTauL. apply IHIHHeutt'; auto.
+      * (* m1 = Tau m1_body *)
+        apply (IHIHHeutt' m1_body m2); auto.
+        apply ruttF_inv_tau_l in H. exact H.
+      * (* m1 = Vis e1 k1 *)
+        remember (VisF e1 k1) as oVisL eqn:HoVisL.
+        clear Hobs_m1 m1 IHIHHeutt'.
+        revert H.
+        induction IHHeutt'; try discriminate; intros.
+        ** symmetry in HoVisL; dependent destruction HoVisL.
+           apply EqTauR.
+           remember (VisF e k0) as oVisL2 eqn:HoVisL2.
+           induction H; try discriminate.
+           *** dependent destruction HoVisL2.
+               apply EqVis; auto. intros a b HAns.
+               apply CIH with (k0 a).
+               **** apply REL.
+               **** apply H0; auto.
+           *** apply EqTauR. apply IHruttF; auto.
+        ** apply EqTauL. apply IHIHHeutt'; auto.
+    + (* EqTauR of Heutt' *)
+      apply EqTau. apply CIH with m1.
+      * rewrite <- tau_eutt with (t:=m1). step. subst t1''. exact Heutt'.
+      * unfold rutt. step. exact H.
+  - (* EqVis *)
+    step in Heutt'. cbn in Heutt'.
+    rewrite <- Hot1' in Heutt'. clear tt1 Hot1' tt2 Hot2'.
+    remember (VisF e1 k1) as oVisL eqn:HoVisL.
+    induction Heutt'; try discriminate; intros.
+    + dependent destruction HoVisL.
+      apply EqVis; auto. intros a b HAns.
+      apply CIH with (k1 a).
+      * apply REL.
+      * apply H0; auto.
+    + apply EqTauL. apply IHHeutt'; auto.
+  - (* EqTauL *)
+    eapply IHHrutt with (t1 := m1) (t1' := tt1') (t2 := tt2); auto.
+    rewrite <- tau_eutt with (t:=m1). rewrite <- Heutt'.
+    rewrite (itree_eta tt1). rewrite <- Hot1'. reflexivity.
+  - (* EqTauR *)
+    apply EqTauR. eapply IHHrutt; eauto.
 Qed.
 
 #[global] Instance rutt_Proper_R3 {E1 E2 R1 R2}:
@@ -278,36 +376,6 @@ Context (REv : forall (A B : Type), E1 A -> E2 B -> Prop).
 Context (RAns : forall (A B : Type), E1 A -> A -> E2 B -> B -> Prop).
 Context (RR : R1 -> R2 -> Prop).
 
-Inductive rutt_bind_clo (r : itree E1 R1 -> itree E2 R2 -> Prop) :
-  itree E1 R1 -> itree E2 R2 -> Prop :=
-| rbc_intro_h U1 U2 (RU : U1 -> U2 -> Prop) t1 t2 k1 k2
-      (EQV: rutt REv RAns RU t1 t2)
-      (REL: forall u1 u2, RU u1 u2 -> r (k1 u1) (k2 u2))
-  : rutt_bind_clo r (ITree.bind t1 k1) (ITree.bind t2 k2)
-.
-Hint Constructors rutt_bind_clo: core.
-
-Lemma rutt_clo_bind :
-  rutt_bind_clo <3= gupaco2 (rutt_ REv RAns RR) (euttge_trans_clo RR).
-Proof.
-  intros rr. gcofix CIH. intros. destruct PR.
-  gclo; econstructor; auto_ctrans_eq.
-  1,2: rewrite unfold_bind; reflexivity.
-  punfold EQV. unfold rutt_ in *.
-  hinduction EQV before CIH; intros; pclearbot; cbn;
-    repeat (change (ITree.subst ?k ?m) with (ITree.bind m k)).
-  - gclo. econstructor; auto_ctrans_eq.
-    1,2: reflexivity.
-    eauto with paco.
-  - gstep. econstructor. eauto 7 with paco.
-  - gstep. econstructor; eauto 7 with paco.
-    intros. specialize (H0 a b H1). pclearbot. eauto 7 with paco.
-  - gclo. econstructor; auto_ctrans_eq; cycle -1; eauto; try reflexivity.
-    eapply eqit_Tau_l. rewrite unfold_bind. reflexivity.
-  - gclo. econstructor; auto_ctrans_eq; cycle -1; eauto; try reflexivity.
-    eapply eqit_Tau_l. rewrite unfold_bind. reflexivity.
-Qed.
-
 End RuttBind.
 
 Lemma rutt_bind {E1 E2 R1 R2 T1 T2}
@@ -320,11 +388,27 @@ Lemma rutt_bind {E1 E2 R1 R2 T1 T2}
       rutt REv RAns RT (k1 r1) (k2 r2)) ->
     rutt REv RAns RT (ITree.bind t1 k1) (ITree.bind t2 k2).
 Proof.
-  intros. ginit.
-  (* For some reason [guclo] fails, apparently trying to infer the type in a
-     context with less information? *)
-  eapply gpaco2_uclo; [|eapply rutt_clo_bind|]; eauto with paco.
-  econstructor; eauto. intros; subst. gfinal. right. apply H0. eauto.
+  revert t1 t2. coinduction c CIH. icbn. intros t1 t2 Hrutt EQK.
+  step in Hrutt.
+  genobs t1 ot1. genobs t2 ot2.
+  hinduction Hrutt before CIH; intros.
+  - (* Ret *)
+    rewrite !observe_bind; simpobs.
+    specialize (EQK _ _ H).
+     step in EQK. now do 2 step.
+  - (* Tau *)
+    rewrite !observe_bind; simpobs.
+    apply EqTau. apply CIH; auto.
+  - (* Vis *)
+    rewrite !observe_bind; simpobs.
+    apply EqVis; auto. intros a b HAns.
+    apply CIH; auto. now apply H0. 
+  - (* TauL *)
+    rewrite observe_bind; simpobs.
+    apply EqTauL. apply IHHrutt; auto.
+  - (* TauR *)
+    setoid_rewrite observe_bind at 2; simpobs.
+    apply EqTauR. apply IHHrutt; auto.
 Qed.
 
 
@@ -337,36 +421,32 @@ Section RuttMrec.
               rutt (sum_prerel RPreInv RPre) (sum_postrel RPostInv RPost)
             (fun (a : A) (b : B) => RPostInv A B d1 a d2 b) (bodies1 A d1) (bodies2 B d2) ).
 
-
   Lemma interp_mrec_rutt (R1 R2 : Type) (RR : R1 -> R2 -> Prop) : forall  (t1 : itree (D1 +' E1) R1) (t2 : itree (D2 +' E2) R2),
       rutt (sum_prerel RPreInv RPre) (sum_postrel RPostInv RPost) RR t1 t2 ->
       rutt RPre RPost RR (interp_mrec bodies1 t1) (interp_mrec bodies2 t2).
   Proof.
-    ginit. gcofix CIH.
-    intros t1 t2 Ht12. punfold Ht12. red in Ht12.
+    coinduction c CIH. icbn. 
+    intros t1 t2 Ht12. step in Ht12. 
     remember (observe t1) as ot1. remember (observe t2) as ot2.
-    hinduction Ht12 before r; intros.
+    hinduction Ht12 before R1; intros; to_rmon. 
     - apply simpobs in Heqot1, Heqot2. rewrite Heqot1, Heqot2.
-      gstep. red. cbn. constructor. auto.
+      repeat rewrite unfold_interp_mrec. cbn. now constructor.  
     - apply simpobs in Heqot1, Heqot2. rewrite Heqot1, Heqot2.
-      repeat rewrite unfold_interp_mrec. cbn. gstep. constructor.
-      pclearbot. gfinal. eauto.
+      repeat rewrite unfold_interp_mrec. cbn. constructor; now apply CIH. 
     - apply simpobs in Heqot1, Heqot2. rewrite Heqot1, Heqot2.
       repeat rewrite unfold_interp_mrec. cbn.
       inv H.
-      + apply inj_pair2 in H1, H4. subst. gstep. constructor.
-        gfinal. left. eapply CIH.
+      + apply inj_pair2 in H1, H4. subst. constructor.
+        eapply CIH.  
         eapply rutt_bind; eauto.
-        intros. cbn in H. clear - H H0. specialize (H0 r1 r2 (sum_postrel_inl _ _ _ _ _ _ _ _ H)).
-        pclearbot. auto.
-      + apply inj_pair2 in H1, H4. subst. gstep. constructor.
-        auto. intros. repeat rewrite tau_euttge. gfinal. left. eapply CIH.
-        clear - H0 H. specialize (H0 a b (sum_postrel_inr _ _ _ _ _ _ _ _ H)).
-        pclearbot. auto.
-    - apply simpobs in Heqot1. rewrite Heqot1. rewrite unfold_interp_mrec at 1. cbn.
-      rewrite tau_euttge. auto.
+        intros. cbn in H. clear - H H0. apply H0. now constructor.
+      + apply inj_pair2 in H1, H4. subst. constructor.
+        auto. intros. repeat rewrite tau_euttge. eapply CIH. 
+        clear - H0 H. apply H0. now constructor. 
+    - apply simpobs in Heqot1. rewrite Heqot1. rewrite unfold_interp_mrec at 1. 
+      cbn. constructor. now apply IHHt12. 
     - apply simpobs in Heqot2. rewrite Heqot2. setoid_rewrite unfold_interp_mrec at 2.
-      cbn. rewrite tau_euttge. auto.
+      cbn. constructor. now apply IHHt12. 
   Qed.
 
   Lemma mrec_rutt (A B : Type) (d1 : D1 A) (d2 : D2 B) : 
diff --git a/theories/Eq/Shallow.v b/theories/Eq/Shallow.v
index 8cfa2411..52afbf81 100644
--- a/theories/Eq/Shallow.v
+++ b/theories/Eq/Shallow.v
@@ -11,7 +11,7 @@
  *)
 
 (* begin hide *)
-From Coq Require Import Morphisms.
+From Stdlib Require Import Morphisms.
 
 From ITree Require Import Core.ITreeDefinition.
 
diff --git a/theories/Eq/SimUpToTaus.v b/theories/Eq/SimUpToTaus.v
index 4210985b..83b72e29 100644
--- a/theories/Eq/SimUpToTaus.v
+++ b/theories/Eq/SimUpToTaus.v
@@ -15,19 +15,18 @@
   [eutt_sutt] and [sutt_eutt].
  *)
 
-From Paco Require Import paco.
+From Coinduction Require Import all.
 
-From Coq Require Import
-     Morphisms.
+From Stdlib Require Import
+     Morphisms
+     Program.Basics.
 
 From ITree Require Import
      Axioms
      Basics.Utils
      Core.ITreeDefinition
      Eq.Eqit
-     Eq.UpToTaus
-     Eq.Shallow
-     Eq.Paco2.
+     Eq.Shallow.
 
 Section SUTT.
 
@@ -48,8 +47,13 @@ Inductive suttF (sutt: itree' E R1 -> itree' E R2 -> Prop) :
 .
 Hint Constructors suttF : itree.
 
+Lemma suttF_mono : Proper (leq ==> leq) suttF.
+Proof. monauto. Qed.
+
+Definition sutt_mon := {| body := suttF ; Hbody := suttF_mono |}.
+
 Definition sutt (t1 : itree E R1) (t2 : itree E R2) :=
-  paco2 suttF bot2 (observe t1) (observe t2).
+  gfp sutt_mon (observe t1) (observe t2).
 Hint Unfold sutt : itree.
 
 End SUTT.
@@ -73,14 +77,8 @@ Section SUTT_facts.
 
 Context {E : Type -> Type} {R1 R2 : Type} (RR : R1 -> R2 -> Prop).
 
-Lemma monotone_suttF : monotone2 (@suttF E _ _ RR).
-Proof. repeat red; intros. induction IN; eauto with itree. Qed.
-Hint Resolve monotone_suttF : paco.
-
 End SUTT_facts.
 
-Global Hint Resolve monotone_suttF : paco.
-
 Lemma suttF_inv_vis {E R1 R2} (RR : R1 -> R2 -> Prop) sutt :
   forall X e (k1 : X -> itree E R1) (k2 : X -> itree E R2),
     suttF RR sutt (VisF e k1) (VisF e k2) ->
@@ -94,8 +92,8 @@ Lemma sutt_inv_vis {E R1 R2} (RR : R1 -> R2 -> Prop) :
   sutt RR (Vis e k1) (Vis e k2) ->
   forall x, sutt RR (k1 x) (k2 x).
 Proof.
-  intros. pstep. punfold H. simpl in *.
-  eapply suttF_inv_vis in H; pclearbot; punfold H.
+  intros. step in H. simpl in H.
+  now apply (suttF_inv_vis _ _ _ _ _ _ H).
 Qed.
 
 Lemma sutt_tau_right {E R1 R2} (RR : R1 -> R2 -> Prop) :
@@ -103,9 +101,8 @@ Lemma sutt_tau_right {E R1 R2} (RR : R1 -> R2 -> Prop) :
     sutt RR t1 t2 ->
     sutt RR t1 (Tau t2).
 Proof.
-  intros. punfold H. pstep.
-  repeat red. repeat red in H. constructor.
-  auto.
+  intros. step. step in H.
+  constructor. auto.
 Qed.
 
 Lemma sutt_tau_left {E R1 R2} (RR : R1 -> R2 -> Prop) :
@@ -113,9 +110,8 @@ Lemma sutt_tau_left {E R1 R2} (RR : R1 -> R2 -> Prop) :
     sutt RR t1 t2 ->
     sutt RR (Tau t1) t2.
 Proof.
-  intros. punfold H. pstep.
-  repeat red. repeat red in H. constructor.
-  eauto with paco.
+  intros. step.
+  constructor. exact H.
 Qed.
 
 Lemma sutt_elim_tau_right {E R1 R2} (RR : R1 -> R2 -> Prop) :
@@ -123,22 +119,22 @@ Lemma sutt_elim_tau_right {E R1 R2} (RR : R1 -> R2 -> Prop) :
     sutt RR t1 (Tau t2) ->
     sutt RR t1 t2.
 Proof.
-  pcofix CIH. pstep. intros.
-  punfold H0. repeat red in H0.
-  inv H0.
-  - eapply monotone_suttF; eauto using upaco2_mon_bot with paco.
-  - constructor. pclearbot. eauto with paco.
+  unfold sutt at -1. icoinduction c CIH. intros t1 t2 H. step in H.
+  inv H.
+  - eapply suttF_mono; [|exact EQTAUS].
+    intros ?? ?. now apply (gfp_chain c).
+  - constructor. apply CIH. exact EQTAUS.
 Qed.
 
 Lemma suttF_inv_tau_left {E R1 R2} (RR : R1 -> R2 -> Prop) :
   forall (t1: itree E R1) ot2,
-    suttF RR (upaco2 (suttF RR) bot2) (TauF t1) ot2 ->
-    suttF RR (upaco2 (suttF RR) bot2) (observe t1) ot2.
+    suttF RR (gfp (@sutt_mon E R1 R2 RR)) (TauF t1) ot2 ->
+    suttF RR (gfp (@sutt_mon E R1 R2 RR)) (observe t1) ot2.
 Proof.
   intros.
   remember (TauF t1) as ott1.
   induction H; intros; subst; try dependent destruction Heqott1; eauto with itree.
-  pclearbot. punfold EQTAUS. 
+  step in EQTAUS. exact EQTAUS.
 Qed.
 
 Lemma sutt_inv_tau_left {E R1 R2} (RR : R1 -> R2 -> Prop) :
@@ -146,8 +142,7 @@ Lemma sutt_inv_tau_left {E R1 R2} (RR : R1 -> R2 -> Prop) :
     sutt RR (Tau t1) t2 ->
     sutt RR t1 t2.
 Proof.
-  intros.
-  punfold H. pstep. repeat red in H |- *.
+  intros. step in H. step.
   apply suttF_inv_tau_left; auto.
 Qed.
 
@@ -155,31 +150,42 @@ Theorem sutt_eutt {E R1 R2} (RR : R1 -> R2 -> Prop) :
   forall (t1 : itree E R1) (t2 : itree E R2),
     sutt RR t1 t2 -> sutt (flip RR) t2 t1 -> eutt RR t1 t2.
 Proof.
-  pcofix CIH. intros.
-  punfold H0. punfold H. pstep. red.
-  induction H0; intros; subst; auto with itree.
-  - constructor. intro. right. eapply suttF_inv_vis in H. pclearbot. eauto with paco itree.
-  - constructor; eauto. eapply IHsuttF; auto. eapply suttF_inv_tau_left; auto.
-  - (* doing induction when one of the trees is a tau doesn't work well *)
-    inv H; pclearbot.
+  icoinduction c CIH. intros t1 t2 H1 H2.
+  step in H1. step in H2.
+  induction H1; intros; subst; auto with itree.
+  - (* suttF_vis *)
+    constructor. intro x. apply CIH.
+    + unfold sutt. exact (SUTTK x).
+    + unfold sutt. exact (suttF_inv_vis _ _ _ _ _ _ H2 x).
+  - (* suttF_tau_right *)
+    constructor; eauto. eapply IHsuttF; auto. eapply suttF_inv_tau_left; auto.
+  - (* suttF_tau_left *)
+    inv H2.
     + clear t1 t2. genobs t0 ot0.
-      hinduction EQTAUS0 before CIH; intros; subst; pclearbot.
+      hinduction EQTAUS0 before CIH; intros; subst.
       * constructor; eauto. simpobs. constructor. eauto.
-      * constructor; eauto. simpobs. constructor. intros.
-        right. apply CIH; auto with itree. eapply sutt_inv_vis in EQTAUS; eauto with itree.
+      * constructor; eauto. simpobs. constructor. intro x.
+        apply CIH.
+        -- exact (sutt_inv_vis _ _ _ _ _ EQTAUS x).
+        -- unfold sutt. apply SUTTK.
       * constructor; eauto. simpobs. eapply IHEQTAUS0; eauto.
-        rewrite (itree_eta' ot1). apply sutt_inv_tau_left; auto.
-      * constructor. right. apply CIH; auto. apply sutt_elim_tau_right; auto.
-    + constructor. right. apply CIH; apply sutt_elim_tau_right; auto.
+        rewrite (itree_eta' ot1). apply sutt_inv_tau_left. unfold sutt. exact EQTAUS.
+      * constructor. apply CIH; auto. apply sutt_elim_tau_right; auto.
+    + constructor. apply CIH; apply sutt_elim_tau_right; auto.
 Qed.
 
 Theorem eutt_sutt {E R1 R2} (RR : R1 -> R2 -> Prop) :
   forall (t1 : itree E R1) (t2 : itree E R2),
     eutt RR t1 t2 -> sutt RR t1 t2.
 Proof.
-  pcofix CIH. pstep. intros.
-  punfold H0. red in H0.
-  induction H0; constructor; pclearbot; eauto 7 with paco itree.
+  coinduction c CIH. intros t1 t2 H.
+  step in H.
+  induction H.
+  - constructor; auto.
+  - constructor. constructor. apply CIH. exact REL.
+  - constructor. intro. apply CIH. apply REL.
+  - constructor. step. exact IHeqitF.
+  - constructor. exact IHeqitF.
 Qed.
 
 (** Generalized heterogeneous version of [eutt_bind] *)
@@ -189,15 +195,17 @@ Lemma sutt_bind' {E R1 R2 S1 S2} {RR: R1 -> R2 -> Prop} {SS: S1 -> S2 -> Prop}:
     forall s1 s2, (forall r1 r2, RR r1 r2 -> sutt SS (s1 r1) (s2 r2)) ->
                   @sutt E _ _ SS (ITree.bind t1 s1) (ITree.bind t2 s2).
 Proof.
-  pcofix self. pstep. intros.
-  punfold H0. unfold observe; cbn.
-  induction H0; intros.
-  - simpl. apply H1 in H. punfold H. eapply monotone_suttF; eauto using upaco2_mon_bot.
-  - simpl. pclearbot. econstructor. eauto with itree.
-  - constructor. eauto with paco.
-  - constructor. pclearbot.
-    right. specialize (self t0 (go ot2) EQTAUS _ _ H1).
-    apply self.
+  coinduction c CIH. intros t1 t2 H s1 s2 Hs.
+  step in H. unfold observe; cbn.
+  induction H; intros.
+  - simpl. apply Hs in H. step in H.
+    eapply suttF_mono; [|exact H].
+    intros ?? ?. now apply (gfp_chain c).
+  - simpl. econstructor. intros. apply CIH; eauto with itree.
+  - constructor. eauto.
+  - constructor.  
+    change (elem c (observe (ITree.bind t0 s1)) (observe (ITree.bind (go ot2) s2))).
+    apply CIH; auto.
 Qed.
 
 (* todo: this could be made stronger with eutt rather than eq_itree
@@ -206,18 +214,22 @@ Qed.
 : Proper (eq_itree eq ==> eq_itree eq ==> flip impl)
        (@sutt E R1 R2 r).
 Proof.
-  repeat red. pcofix CIH; pstep. intros.
-  punfold H0; punfold H1; punfold H2. red in H0, H1.
-  (* rename H1 into H2, Hxy into H1.  *)
-  hinduction H2 before CIH; subst; intros.
-  - inv H0; try discriminate. inv H1; try discriminate. econstructor. eauto.
-  - dependent destruction H0; try discriminate.
-    dependent destruction H1; try discriminate.
-    simpobs. pclearbot.
-    constructor. intros. right. eauto 7 with paco itree.
-  - dependent destruction H1; try discriminate.
-    simpobs. pclearbot. punfold REL. auto with itree.
+  repeat red. coinduction c CIH. intros x y H x0 y0 H0 H1.
+  step in H. step in H0. step in H1.
+  revert x H x0 H0.
+  induction H1; intros.
+  - inv H1; try discriminate. inv H0; try discriminate. econstructor. eauto.
+  - dependent destruction H; try discriminate.
+    dependent destruction H0; try discriminate.
+    simpobs.
+    constructor. intros. eapply CIH. 
+    apply REL. 
+    apply REL0. apply SUTTK.  
   - dependent destruction H0; try discriminate.
-    simpobs. pclearbot. constructor.
-    right. rewrite (itree_eta' ot2) in *. eauto with itree.
-Qed.
+    simpobs. constructor. 
+    apply IHsuttF; auto. now step in REL. 
+  - dependent destruction H; try discriminate.
+    simpobs. constructor.
+    rewrite (itree_eta' ot2) in *. eapply CIH. 
+    apply REL. step; apply H0. apply EQTAUS. 
+Qed.
\ No newline at end of file
diff --git a/theories/Eq/UpToTaus.v b/theories/Eq/UpToTaus.v
deleted file mode 100644
index 325220b5..00000000
--- a/theories/Eq/UpToTaus.v
+++ /dev/null
@@ -1,880 +0,0 @@
-(** * Equivalence up to taus *)
-
-(** Abbreviated as [eutt]. *)
-
-(** We consider [Tau] as an "internal step", that should not be
-   visible to the outside world, so adding or removing [Tau]
-   constructors from an itree should produce an equivalent itree.
-
-   We must be careful because there may be infinite sequences of
-   taus (i.e., [spin]). Here we shall only allow inserting finitely
-   many [Tau]s between any two visible steps ([Ret] or [Vis]), so that
-   [spin] is only related to itself. This ensures that equivalence
-   up to taus is transitive (and in fact an equivalence relation).
- *)
-
-(** A rewrite hint database named [itree] is available via the tactic
-    [autorewrite with itree] as a custom simplifier of expressions using
-    mainly [Ret], [Tau], [Vis], [ITree.bind] and [ITree.Interp.Interp.interp].
- *)
-
-(** This file contains only the definition of the [eutt] relation.
-    Theorems about [eutt] are split in two more modules:
-
-    - [ITree.Eq.UpToTausCore] proves that [eutt] is reflexive, symmetric,
-      and that [ITree.Eq.Eqit.eq_itree] is a subrelation of [eutt].
-      Equations for [ITree.Core.ITreeDefinition] combinators which only rely on
-      those properties can also be found here.
-
-    - [ITree.Eq.UpToTausEquivalence] proves that [eutt] is transitive,
-      and, more generally, contains theorems for up-to reasoning in
-      coinductive proofs.
- *)
-
-(** Splitting things this way makes the library easier to build in parallel.
- *)
-
-(* begin hide *)
-From Coq Require Import Setoid Morphisms Relations.
-From Paco Require Import paco.
-
-From ITree Require Import
-     Basics.Utils
-     Core.ITreeDefinition
-     Eq.Eqit
-     Eq.Paco2
-     Eq.Shallow.
-
-#[local] Open Scope itree_scope.
-(* end hide *)
-
-(** ** gpaco
-*)
-
-Tactic Notation "gpaco_" :=
-  match goal with
-  | [|- context[gpaco2]] => eapply gpaco2_gpaco; [eauto with paco|]
-  end.
-Ltac gpaco := repeat red; under_forall ltac:(gpaco_).
-
-(**** END ****)
-
-Section EUTTG.
-
-Context {E : Type -> Type} {R1 R2 : Type} (RR : R1 -> R2 -> Prop).
-
-Definition transU := @eqit_trans_clo E R1 R2 RR true true true true.
-Definition transD := @eqit_trans_clo E R1 R2 RR true true false false.
-Definition bindC := @eqit_bind_clo E R1 R2 true true.
-
-Definition euttVC gH r :=
-  gupaco2 (eqit_ RR true true id) transD (transU (r \2/ gH)).
-
-Variant euttG rH rL gL gH t1 t2 : Prop :=
-| euttG_intro
-    (IN: gpaco2 (@eqit_ E R1 R2 RR true true (euttVC gH)) transD (transU rH \2/ rL) gL t1 t2)
-.
-
-Hint Unfold transU transD bindC euttVC : itree.
-Hint Constructors euttG : itree.
-
-Lemma transD_mon r1 r2 t1 t2
-      (IN: transD r1 t1 t2)
-      (LE: r1 <2= r2):
-  transD r2 t1 t2.
-Proof. eapply eqitC_mon, LE; eauto. Qed.
-
-Lemma transU_mon r1 r2 t1 t2
-      (IN: transU r1 t1 t2)
-      (LE: r1 <2= r2):
-  transU r2 t1 t2.
-Proof.
-  destruct IN. econstructor; eauto.
-Qed.
-
-Lemma transDleU: transD <3= transU.
-Proof.
-  intros. destruct PR. econstructor; eauto using eqit_mon.
-Qed.
-
-Lemma transD_compose:
-  compose transD transD <3= transD.
-Proof.
-  intros. destruct PR. destruct REL.
-  econstructor; try eapply eqit_trans; eauto; auto_ctrans.
-Qed.
-
-Lemma transU_compose:
-  compose transU transU <3= transU.
-Proof.
-  intros. destruct PR. destruct REL.
-  econstructor; try eapply eqit_trans; eauto; auto_ctrans.
-Qed.
-
-Lemma transD_id: id <3= transD.
-Proof. intros. econstructor; try reflexivity; auto_ctrans. Qed.
-
-Lemma transU_id: id <3= transU.
-Proof. intros. econstructor; try reflexivity; auto_ctrans. Qed.
-
-Hint Resolve transD_mon transU_mon : paco.
-
-Lemma euttVC_mon gH:
-  monotone2 (euttVC gH).
-Proof.
-  red; intros.
-  eapply gupaco2_mon; eauto. intros.
-  eapply transU_mon; eauto. intros.
-  destruct PR0; eauto.
-Qed.
-Hint Resolve euttVC_mon : paco.
-
-Lemma euttVC_compat gH:
-  compose transD (euttVC gH) <3= compose (euttVC gH) transD.
-Proof.
-  intros. gclo. eapply transD_mon; eauto. intros.
-  eapply gupaco2_mon; eauto. intros.
-  eapply transU_mon; eauto. intros.
-  destruct PR2; eauto.
-  left. econstructor; try reflexivity; auto_ctrans.
-Qed.
-Hint Resolve euttVC_compat : paco.
-
-Lemma euttVC_id gH:
-  id <3= euttVC gH.
-Proof.
-  intros. gbase. econstructor; try reflexivity; auto_ctrans.
-Qed.
-Hint Resolve euttVC_id : paco.
-
-End EUTTG.
-
-#[global] Hint Unfold transU transD bindC euttVC : itree.
-#[global] Hint Constructors euttG : itree.
-#[global] Hint Resolve transD_mon transU_mon : paco.
-#[global] Hint Resolve euttVC_mon : paco.
-#[global] Hint Resolve euttVC_compat : paco.
-#[global] Hint Resolve transD_id transU_id euttVC_id : paco.
-
-#[global]
-Instance geuttG_cong_euttge {E R1 R2 RR} gH r g:
-  Proper (euttge eq ==> euttge eq ==> flip impl)
-         (gpaco2 (@eqit_ E R1 R2 RR true true (euttVC RR gH)) (transD RR) r g).
-Proof.
-  repeat intro. guclo eqit_clo_trans. econstructor; eauto; auto_ctrans.
-Qed.
-
-#[global]
-Instance geuttG_cong_eq {E R1 R2 RR} gH r g:
-  Proper (eq_itree eq ==> eq_itree eq ==> flip impl)
-         (gpaco2 (@eqit_ E R1 R2 RR true true (euttVC RR gH)) (transD RR) r g).
-Proof.
-  repeat intro. eapply geuttG_cong_euttge;
-    [ eapply eq_sub_euttge; eassumption .. | eauto with itree ].
-Qed.
-
-Lemma eqit_ret_gen {E R1 R2 RR} t v
-      (IN: @eqit E R1 R2 RR true true t (Ret v)):
-  eqit RR true false t (Ret v).
-Proof.
-  punfold IN. pstep. red in IN |- *. simpl in *.
-  remember (RetF v) as ot.
-  hinduction IN before RR; intros; subst; try inv Heqot; eauto with itree.
-Qed.
-
-Section EUTTG_Properties1.
-
-Context {E : Type -> Type} {R1 R2 : Type} (RR : R1 -> R2 -> Prop).
-
-Local Notation euttG := (@euttG E R1 R2 RR).
-
-Lemma rclo_transD r:
-  rclo2 (transD RR) r <2= @transD E R1 R2 RR r.
-Proof.
-  intros. induction PR; eauto with paco.
-  destruct IN. apply H in REL. destruct REL.
-  econstructor; try apply REL; try eapply eqit_trans; eauto; auto_ctrans.
-Qed.
-
-Lemma rclo_flip clo (r: itree E R1 -> itree E R2 -> Prop)
-      (MON: monotone2 clo):
-  flip (rclo2 (fun x : itree E R2 -> itree E R1 -> Prop => flip (clo (flip x))) (flip r)) <2= rclo2 clo r.
-Proof.
-  intros. induction PR; eauto with paco.
-  apply rclo2_clo; eauto.
-Qed.
-
-Lemma transD_flip r:
-  flip (transD (flip RR) (flip r)) <2= @transD E _ _ RR r.
-Proof.
-  unfold flip. intros. destruct PR. econstructor; eauto.
-Qed.
-
-Lemma transU_flip r:
-  flip (transU (flip RR) (flip r)) <2= @transU E R1 R2 RR r.
-Proof.
-  unfold flip. intros. destruct PR. econstructor; eauto.
-Qed.
-
-Lemma euttVC_flip gH r:
-  flip (euttVC (flip RR) (flip gH) (flip r)) <2= @euttVC E R1 R2 RR gH r.
-Proof.
-  pcofix CIH. intros. gunfold PR.
-  gclo. apply rclo_transD.
-  eapply rclo_flip; eauto with paco.
-  eapply rclo2_mon_gen; eauto; intros.
-  { eapply transD_flip. eauto. }
-  destruct PR0; cycle 1.
-  { gbase. destruct H; eauto using transU_flip with itree. }
-  gstep. apply eqitF_flip.
-  eapply eqitF_mono; eauto with paco. intros.
-  gbase. eapply CIH.
-  eapply gupaco2_mon; eauto. intros.
-  destruct PR1; eauto.
-Qed.
-
-Lemma euttG_flip gH r:
-  flip (gupaco2 (eqit_ (flip RR) true true (euttVC (flip RR) (flip gH))) (transD (flip RR)) (flip r)) <2=
-  gupaco2 (@eqit_ E R1 R2 RR true true (euttVC RR gH)) (transD RR) r.
-Proof.
-  pcofix CIH; intros.
-  destruct PR. econstructor.
-  eapply rclo_flip; eauto with paco.
-  eapply rclo2_mon_gen; [ eauto using transD_flip with itree .. | ]. intros.
-  destruct PR; [ | eauto with itree ].
-  left. punfold H. pstep. apply eqitF_flip.
-  eapply eqitF_mono; eauto with paco; intros.
-  - eapply euttVC_flip. apply PR.
-  - apply rclo_flip; eauto with paco.
-    eapply rclo2_mon_gen; [ eauto using transD_flip with paco itree .. | ].
-    intros. right. left. destruct PR0.
-    + eapply CIH. red. eauto with paco.
-    + apply CIH0. destruct H0; eauto.
-Qed.
-
-Lemma transD_dist:
-  forall r1 r2, @transD E R1 R2 RR (r1 \2/ r2) <2= (transD RR r1 \2/ transD RR r2).
-Proof. apply eqitC_dist. Qed.
-
-Lemma transU_dist:
-  forall r1 r2, @transU E R1 R2 RR (r1 \2/ r2) <2= (transU RR r1 \2/ transU RR r2).
-Proof.
-  intros. destruct PR. destruct REL; [left|right]; eauto with itree.
-Qed.
-
-Lemma transU_dist_rev:
-  forall r1 r2, (transU RR r1 \2/ transU RR r2) <2= @transU E R1 R2 RR (r1 \2/ r2).
-Proof.
-  intros. destruct PR, H; eauto with itree.
-Qed.
-
-Variant transL (r: itree E R1 -> itree E R2 -> Prop) (t1: itree E R1) (t2: itree E R2) : Prop :=
-| transL_intro t' RR1
-               (EQL: eqit RR1 true true t1 t')
-               (EQR: r t' t2)
-               (LERR: forall x x' y, RR1 x x' -> RR x' y -> RR x y)
-  : transL r t1 t2
-.
-Hint Constructors transL : itree.
-
-Lemma transD_transL r:
-  transD RR (transL r) <2= transL (transD RR r).
-Proof.
-  intros. destruct PR, REL.
-  econstructor; [|econstructor|]; try apply EQR.
-  - eapply eqit_trans.
-    + apply euttge_sub_eutt. eauto.
-    + eauto.
-  - reflexivity.
-  - eauto.
-  - auto_ctrans.
-  - auto_ctrans.
-  - auto_ctrans.
-Qed.
-
-Lemma transLleU: transL <3= transU RR.
-Proof.
-  intros. destruct PR. econstructor; eauto. reflexivity. auto_ctrans.
-Qed.
-
-Lemma transL_closed vclo r
-      (MON: monotone2 vclo)
-      (COMP: wcompatible2 (eqit_ RR true true vclo) (transD RR))
-      (CLOV: forall r (CLOL: transL r <2= r), transL (vclo r) <2= vclo r)
-      (CLOL: transL r <2= r)
-      (CLOD: transD RR r <2= r):
-  transL (gupaco2 (eqit_ RR true true vclo) (transD RR) r)
-  <2= gupaco2 (eqit_ RR true true vclo) (transD RR) r.
-Proof.
-  pcofix CIH. intros t1 t2 [].
-  apply gpaco2_dist in EQR; eauto with paco.
-  destruct EQR; cycle 1.
-  { gbase. apply rclo_transD in H. destruct H. eauto 6 with itree. }
-  assert (REL: paco2 (eqit_ RR true true vclo) r t' t2).
-  { eapply paco2_mon; eauto. intros.
-    apply rclo_transD in PR. apply CLOD.
-    eapply transD_mon; eauto. intros. destruct PR0; eauto.
-  }
-  clear H.
-
-  punfold EQL. red in EQL. punfold REL. red in REL. genobs t1 ot1. genobs t' ot'.
-  hinduction EQL before CIH; intros; subst.
-  - remember (RetF r2) as ot. genobs t2 ot2.
-    hinduction REL0 before CIH; intros; subst; try inv Heqot.
-    + gstep. red. simpobs. eauto with itree.
-    + gclo. econstructor; auto_ctrans_eq.
-      * rewrite (simpobs Heqot1). reflexivity.
-      * rewrite (simpobs Heqot2), tau_euttge. reflexivity.
-  - pclearbot. apply eqit_Tau_r in REL. rewrite Heqot' in REL, REL0. clear m2 Heqot'.
-    genobs t' ot'. genobs t2 ot2.
-    hinduction REL0 before CIH; intros; subst.
-    + apply eqit_ret_gen in REL0.
-      gclo. econstructor.
-      * eapply eqit_trans; [rewrite (simpobs Heqot1); reflexivity|].
-        eapply eqit_trans; [rewrite tau_euttge; reflexivity|].
-        eauto.
-      * rewrite (simpobs Heqot2). reflexivity.
-      * gstep. econstructor. eauto.
-      * auto_ctrans.
-      * auto_ctrans.
-    + gstep. red. simpobs. econstructor. gbase.
-      destruct REL.
-      * eapply CIH. econstructor; [|eauto using paco2_mon with paco|].
-        -- eapply eqit_trans; [apply REL0|]. rewrite tau_eutt. reflexivity.
-        -- auto_ctrans.
-      * eapply CIH0. apply CLOL. econstructor; [|eauto|].
-        -- eapply eqit_trans; [apply REL0|]. rewrite tau_eutt. reflexivity.
-        -- auto_ctrans.
-    + punfold REL0. red in REL0. simpl in *.
-      remember (VisF e k1) as ot. genobs m1 ot2.
-      hinduction REL0 before CIH; intros; try discriminate.
-      * inv_Vis. pclearbot. gstep. red. do 2 (simpobs; econstructor; eauto). intros.
-        eapply MON; [|intros; gbase; eapply CIH; eauto].
-        eapply CLOV.
-        { intros. destruct PR, EQR.
-          econstructor; [|eauto|]; eauto using eqit_trans; auto_ctrans. }
-        econstructor; [ eauto with itree | | auto ].
-        eapply MON; eauto. intros.
-        econstructor; try reflexivity; auto_ctrans.
-        gfinal. destruct PR; eauto.
-      * gclo; econstructor; auto_ctrans_eq; try reflexivity.
-        rewrite (simpobs Heqot1), tau_euttge. reflexivity.
-    + eapply IHREL0; try eapply eqit_trans; auto_ctrans_eq.
-      rewrite <-itree_eta, tau_eutt. reflexivity.
-    + gclo; econstructor; auto_ctrans_eq; try reflexivity.
-      rewrite (simpobs Heqot2), tau_euttge. reflexivity.
-  - remember (VisF e k2) as ot. genobs t2 ot2.
-    hinduction REL0 before CIH; intros; subst; try discriminate.
-    + inv_Vis. pclearbot. gstep. red. simpobs. econstructor; eauto. intros.
-      eapply MON; [|intros; gbase; eapply CIH; eauto].
-      eapply CLOV.
-      { intros. destruct PR, EQR.
-        econstructor; swap 1 2; eauto using eqit_trans; auto_ctrans. }
-      econstructor; [ eauto with itree | | auto ].
-      eapply MON; eauto. intros.
-      econstructor; auto_ctrans_eq; try reflexivity.
-      gfinal. destruct PR; eauto.
-    + gclo; econstructor; auto_ctrans_eq; try reflexivity.
-      rewrite (simpobs Heqot2), tau_euttge. reflexivity.
-  - gclo; econstructor; auto_ctrans_eq; try reflexivity.
-    rewrite (simpobs Heqot1), tau_euttge. reflexivity.
-  - clear t' Heqot'. remember (TauF t2) as ot. genobs t0 ot0.
-    hinduction REL before EQL; intros; subst; try inv Heqot; eauto; cycle 1.
-    + gclo; econstructor; auto_ctrans_eq; try reflexivity.
-      rewrite (simpobs Heqot0), tau_euttge. reflexivity.
-    + destruct REL; cycle 1.
-      * gbase. apply CLOL. econstructor; [ eauto with itree | | auto ].
-        apply CLOD. econstructor; auto_ctrans_eq; try reflexivity.
-        rewrite (simpobs Heqot0), tau_euttge. reflexivity.
-      * eapply IHEQL; eauto.
-        simpobs. econstructor; eauto.
-        punfold H.
-Qed.
-
-Lemma euttVC_transL gH r:
-  transL (euttVC RR gH r) <2= euttVC RR gH r.
-Proof.
-  intros. eapply transL_closed; eauto using transU_compose, transLleU, transDleU with paco.
-Qed.
-
-End EUTTG_Properties1.
-
-Section EUTTG_Properties2.
-
-Context {E : Type -> Type} {R1 R2 : Type} (RR : R1 -> R2 -> Prop).
-
-Local Notation euttG := (@euttG E R1 R2 RR).
-
-Lemma euttVC_transU gH r
-      (CLOR: transU RR r <2= r):
-  transU RR (euttVC RR gH r) <2= @euttVC E _ _ RR gH r.
-Proof.
-  intros. destruct PR.
-  eapply euttVC_transL; eauto using transLleU, transDleU with paco.
-  econstructor; eauto.
-  eapply euttVC_flip. unfold flip.
-  eapply euttVC_transL; eauto using transLleU, transDleU, transU_flip with paco.
-  econstructor; eauto.
-  apply euttVC_flip. eauto.
-Qed.
-
-Lemma euttG_transU_aux gH r
-      (CLOR: transU RR r <2= r):
-  transU RR (gupaco2 (eqit_ RR true true (euttVC RR gH)) (transD RR) r) <2= 
-  gupaco2 (@eqit_ E R1 R2 RR true true (euttVC RR gH)) (transD RR) r.
-Proof.
-  intros. destruct PR.
-  eapply transL_closed; eauto using euttVC_transL, transLleU, transDleU with paco.
-  econstructor; eauto.
-  apply euttG_flip. unfold flip.
-  eapply transL_closed;
-   [ eauto using euttVC_transL, transLleU, transDleU, transU_flip with paco itree .. | ].
-  econstructor; eauto using euttG_flip with itree.
-Qed.
-
-Lemma euttVC_gen gH r:
-  transU RR (gupaco2 (eqit_ RR true true (euttVC RR gH)) (transD RR) (transU RR (r \2/ gH)))
-  <2= @euttVC E R1 R2 RR gH r.
-Proof.
-  intros. eapply euttG_transU_aux in PR; eauto using transU_compose.
-  revert x0 x1 PR. pcofix CIH. intros.
-  gunfold PR. apply rclo_transD in PR.
-  gclo. eapply transD_mon; eauto. intros.
-  destruct PR0; eauto with paco.
-  gstep. red in H |- *. induction H; auto with itree.
-  - econstructor. gbase. eapply CIH.
-    eapply gupaco2_mon; eauto. intros.
-    destruct PR0; eauto.
-  - econstructor. intros. gbase. eapply CIH.
-    red in REL. gupaco. eapply gupaco2_mon_gen; eauto with paco; intros.
-    + eapply eqitF_mono; eauto with paco.
-    + eapply euttG_transU_aux; eauto using transU_compose with paco.
-      eapply transU_mon; eauto. intros.
-      destruct PR1; [|eauto 7 with paco].
-      eapply gupaco2_mon; eauto. intros.
-      destruct PR1; eauto.
-Qed.
-
-Lemma euttG_gen rH rL gL gH:
-  euttG rH rL (gL \2/ (transU RR rH \2/ rL)) gH <2= euttG rH rL gL gH.
-Proof.
-  intros. destruct PR. econstructor.
-  eapply gpaco2_gen_guard. eauto.
-Qed.
-
-Lemma euttG_cofix_aux: forall rH rL gL gH x,
-    (x <2= euttG rH rL (gL \2/ x) (gH \2/ x)) -> (x <2= euttG rH rL gL gH).
-Proof.
-  intros. apply euttG_gen.
-  econstructor. revert x0 x1 PR. pcofix CIH.
-  intros t1 t2 PR. apply H in PR. destruct PR as [IN]. revert t1 t2 IN.
-  pcofix CIH. intros.
-  apply gpaco2_dist in IN; eauto with paco.
-  destruct IN; cycle 1.
-  { apply rclo_transD in H0; eauto with paco.
-    gclo. eapply transD_mon; eauto with paco.
-  }
-  assert (LEM: upaco2 (eqit_ RR true true (euttVC RR (gH \2/ x)))
-                      (rclo2 (transD RR) ((gL \2/ x) \2/ (transU RR rH \2/ rL)))
-               <2= gpaco2 (eqit_ RR true true (euttVC RR gH)) (transD RR) r0 r0).
-  { intros m1 m2 [REL|REL].
-    - gbase. apply CIH1.
-      gpaco. gfinal. right.
-      eapply paco2_mon; eauto. intros.
-      apply rclo_transD in PR. gclo. eapply transD_mon; eauto. intros. gbase.
-      repeat destruct PR0 as [PR0|PR0]; eauto.
-    - apply rclo_transD in REL. gclo. eapply transD_mon; eauto. intros. gbase.
-      repeat destruct PR as [PR|PR]; eauto.
-  }
-
-  punfold H0. gstep. red in H0 |- *.
-  induction H0; auto 3 with itree.
-  red in REL. econstructor. intros.
-  eapply gupaco2_mon; eauto. intros.
-  apply transU_dist in PR. destruct PR; eauto using transU_mon.
-  eapply transU_mon; eauto. intros; destruct PR; eauto with paco.
-Qed.
-
-End EUTTG_Properties2.
-
-Section EUTTG_principles.
-
-Context {E : Type -> Type} {R1 R2 : Type} (RR : R1 -> R2 -> Prop).
-
-Local Notation euttG := (@euttG E R1 R2 RR).
-
-(* Make new hypotheses *)
-
-Lemma euttG_cofix rH rL gL gH x
-      (OBG: forall gL' (INCL: gL <2= gL') (CIHL: x <2= gL') gH' (INCH: gH <2= gH') (CIHH: x <2= gH'), x <2= euttG rH rL gL' gH'):
-    x <2= euttG rH rL gL gH.
-Proof.
-  eapply euttG_cofix_aux; intros.
-  eapply OBG; eauto.
-Qed.
-
-Lemma euttG_accF rH rL gL gH X (f : X -> _) (g : X -> _)
-    (OBJ: forall gL' (INCL: gL <2= gL') (CIHL: forall x : X, gL' (f x) (g x)) gH' (INCH: gH <2= gH') (CIHH: forall x : X, gH' (f x) (g x)), forall x : X, euttG rH rL gL' gH' (f x) (g x)):
-    forall x : X, euttG rH rL gL gH (f x) (g x).
-Proof.
-  intros x.
-  apply euttG_cofix with (x := fun a b => exists x, a = (f x) /\ b = (g x)); [ | eauto ].
-  intros. destruct PR as [? [-> ->]]. apply OBJ; eauto.
-Qed.
-
-(* Process itrees *)
-
-Lemma euttG_ret: forall rH rL gL gH v1 v2,
-  RR v1 v2 -> euttG rH rL gL gH (Ret v1) (Ret v2).
-Proof.
-  econstructor. gstep. econstructor. eauto.
-Qed.
-
-Lemma euttG_bind: forall rH rL gL gH t1 t2,
-  bindC (euttG rH rL gL gH) t1 t2 -> euttG rH rL gL gH t1 t2.
-Proof.
-  econstructor. guclo eqit_clo_bind.
-  destruct H. econstructor; eauto.
-  intros. edestruct REL; eauto.
-Qed.
-
-Lemma euttG_transD: forall rH rL gL gH t1 t2,
-  transD RR (euttG rH rL gL gH) t1 t2 -> euttG rH rL gL gH t1 t2.
-Proof.
-  econstructor. guclo eqit_clo_trans.
-  destruct H. econstructor; eauto.
-  edestruct REL; eauto.
-Qed.
-
-(* Drop weak hypotheses for general rewriting *)
-
-Lemma euttG_transU rH rL gL gH t1 t2:
-  transU RR (euttG rH rH rH gH) t1 t2 -> euttG rH rL gL gH t1 t2.
-Proof.
-  intros. apply euttG_gen.
-  cut (gupaco2 (eqit_ RR true true (euttVC RR gH)) (transD RR) (transU RR rH) t1 t2).
-  { intros. econstructor. eapply gpaco2_mon; eauto. }
-  eapply euttG_transU_aux; eauto using transU_compose.
-  eapply transU_mon; eauto. intros. destruct PR.
-  eapply gpaco2_mon; eauto; intros;
-    repeat destruct PR as [PR|PR]; eauto using transU_id.
-Qed.
-
-Lemma euttG_drop rH rL gL gH t1 t2:
-  euttG rH rH rH gH t1 t2 -> euttG rH rL gL gH t1 t2.
-Proof.
-  intros. apply euttG_gen. destruct H. econstructor.
-  eapply gpaco2_mon; intros; eauto; [destruct PR|]; eauto using transU_id. 
-Qed.
-
-(* Make a weakly guarded progress *)
-
-Lemma euttG_tau: forall rH rL gL gH t1 t2,
-  euttG rH gL gL gH t1 t2 -> euttG rH rL gL gH (Tau t1) (Tau t2).
-Proof.
-  intros. apply euttG_gen. destruct H. econstructor.
-  gstep. econstructor.
-  eapply gpaco2_mon; eauto; intros; repeat destruct PR as [PR|PR]; eauto.
-Qed.
-
-(* Make a strongly guarded progress *)
-
-Lemma euttG_vis: forall rH rL gL gH u (e: E u) k1 k2,
-  (forall v, euttG gH gH gH gH (k1 v) (k2 v)) -> euttG rH rL gL gH (Vis e k1) (Vis e k2).
-Proof.
-  econstructor. gstep. econstructor. intros.
-  specialize (H v). destruct H.
-  apply euttVC_gen. econstructor; auto_ctrans_eq; try reflexivity.
-  eapply gpaco2_mon_gen; eauto; intros; repeat destruct PR as [PR|PR];
-    eauto using gpaco2_clo, transDleU, transU_mon with paco.
-Qed.
-
-Lemma euttG_vis_gen rH rL gL gH u1 (e1: E u1) u2 (e2 : E u2) k1 k2 (p : u1 = u2)
-  : eqeq E p e1 e2 -> pweqeq (euttG gH gH gH gH) p k1 k2 ->
-    euttG rH rL gL gH (Vis e1 k1) (Vis e2 k2).
-Proof.
-  econstructor. gstep. apply (eqitF_VisF_gen p); auto. destruct p; cbn in *; intros.
-  specialize (H0 x). destruct H0.
-  apply euttVC_gen. econstructor; auto_ctrans_eq; try reflexivity.
-  eapply gpaco2_mon_gen; eauto; intros; repeat destruct PR as [PR|PR];
-    eauto using gpaco2_clo, transDleU, transU_mon with paco.
-Qed.
-
-(* Use available hypotheses *)
-
-Lemma euttG_base: forall rH rL gL gH t1 t2,
-  rH t1 t2 \/ rL t1 t2 -> euttG rH rL gL gH t1 t2.
-Proof.
-  intros. econstructor. gbase.
-  destruct H; eauto using transU_id.
-Qed.
-
-(**
-   Correctness
- **)
-
-Lemma euttG_le_eutt:
-  euttG bot2 bot2 bot2 bot2 <2= eutt RR.
-Proof.
-  intros. destruct PR.
-  assert(paco2 (eqit_ RR true true (euttVC RR bot2)) bot2 x0 x1).
-  { eapply gpaco2_init; eauto with paco.
-    eapply gpaco2_mon; eauto; intros;
-      repeat destruct PR as [PR|PR]; destruct PR; contradiction.
-  }
-  clear IN.
-  revert x0 x1 H. pcofix CIH. intros.
-  punfold H. pstep. unfold_eqit.
-  induction H; pclearbot; auto with itree.
-  econstructor; intros. specialize (REL v).
-  right. apply CIH.
-  ginit. gupaco. eapply gupaco2_mon_gen; eauto with paco; intros.
-  - eapply eqitF_mono; eauto with paco.
-  - apply euttG_transU_aux.
-    { intros. destruct PR0; contradiction. }
-    eapply transU_mon; eauto. intros.
-    pclearbot. gfinal. eauto.
-Qed.
-
-Lemma eutt_le_euttG rH rL gL gH:
-  eutt RR <2= euttG rH rL gL gH.
-Proof.
-  intros. econstructor. econstructor. apply rclo2_base. left.
-  eapply paco2_mon_bot; eauto; intros.
-  eapply eqitF_mono; eauto with paco.
-Qed.
-
-End EUTTG_principles.
-
-Ltac apply_paco_acc CIH unpack_goal unpack_hyp :=
-  apply euttG_accF;
-  let gL' := fresh "gL'" in
-  let INCL := fresh "INCL" in
-  let CIHL := fresh CIH "L" in
-  let gH' := fresh "gH'" in
-  let INCH := fresh "INCH" in
-  let CIHH := fresh CIH "H" in
-  intros gL' INCL CIHL gH' INCH CIHH;
-  unpack_goal tt;
-  unpack_hyp CIHL;
-  unpack_hyp CIHH.
-
-Ltac ecofix CIH := pcofix_with ltac:(apply_paco_acc CIH).
-
-Ltac einit := repeat red; under_forall ltac:(eapply euttG_le_eutt; eauto with paco itree).
-Ltac efinal := repeat red; under_forall ltac:(eapply eutt_le_euttG; eauto with paco itree).
-Ltac ebase := repeat red; under_forall ltac:(eapply euttG_base; eauto with paco itree).
-Ltac eret := repeat red; under_forall ltac:(eapply euttG_ret; eauto with paco itree).
-Ltac etau := repeat red; under_forall ltac:(eapply euttG_tau; eauto with paco itree).
-Ltac evis := repeat red; under_forall ltac:(eapply euttG_vis; eauto with paco itree).
-Ltac estep := first [eret|etau|evis].
-Ltac ebind := repeat red; under_forall ltac:(eapply euttG_bind; eauto with paco itree).
-Ltac edrop := repeat red; under_forall ltac:(eapply euttG_drop; eauto with paco itree).
-
-Global Hint Resolve euttG_ret : paco.
-Global Hint Resolve euttG_tau : paco.
-Global Hint Resolve euttG_vis : paco.
-Global Hint Resolve euttG_base : paco.
-Global Hint Resolve euttG_le_eutt: paco.
-
-#[global]
-Instance euttG_reflexive {E R} rH rL gL gH:
-  Reflexive (@euttG E R R eq rH rL gL gH).
-Proof.
-  red; intros. efinal. reflexivity.
-Qed.
-
-#[global]
-Instance euttG_cong_eutt {E R1 R2 RR} rH gH:
-  Proper (eutt eq ==> eutt eq ==> flip impl)
-         (@euttG E R1 R2 RR rH rH rH gH).
-Proof.
-  repeat intro. eapply euttG_transU. econstructor; auto_ctrans_eq; eauto.
-Qed.
-
-#[global]
-Instance euttG_cong_euttge {E R1 R2 RR} rH rL gL gH:
-  Proper (euttge eq ==> euttge eq ==> flip impl)
-         (@euttG E R1 R2 RR rH rL gL gH).
-Proof.
-  repeat intro. eapply euttG_transD. econstructor; auto_ctrans_eq; eauto.
-Qed.
-
-#[global]
-Instance euttG_cong_eq {E R1 R2 RR} rH rL gL gH:
-  Proper (eq_itree eq ==> eq_itree eq ==> flip impl)
-         (@euttG E R1 R2 RR rH rL gL gH).
-Proof.
-  repeat intro. eapply euttG_cong_euttge; eauto; apply eq_sub_euttge; eauto.
-Qed.
-
-#[global]
-Instance eutt_cong_eutt {E R1 R2 RR}:
-  Proper (eutt eq ==> eutt eq ==> flip impl)
-         (@eqit E R1 R2 RR true true).
-Proof.
-  einit. intros. rewrite H0, H1. efinal.
-Qed.
-
-#[global]
-Instance eutt_cong_euttge {E R1 R2 RR}:
-  Proper (euttge eq ==> euttge eq ==> flip impl)
-         (@eqit E R1 R2 RR true true).
-Proof.
-  einit. intros. rewrite H0, H1. efinal.
-Qed.
-
-#[global]
-Instance eutt_cong_eq {E R1 R2 RR}:
-  Proper (eq_itree eq ==> eq_itree eq ==> flip impl)
-         (@eqit E R1 R2 RR true true).
-Proof.
-  einit. intros. rewrite H0, H1. efinal.
-Qed.
-
-#[global]
-Instance eutt_cong_eutt' {E R1 R2 RR} :
-  Proper (eutt eq ==> eutt eq ==> flip impl) (@eutt E R1 R2 RR).
-Proof.
-  apply eutt_cong_eutt.
-Qed.
-
-(* Specialization of [eutt_clo_bind] to the recurrent case where [UU := eq]
-   in order to avoid having to provide the relation manually everytime *)
-Lemma eutt_eq_bind : forall E R1 R2 RR U (t: itree E U) (k1: U -> itree E R1) (k2: U -> itree E R2),
-    (forall u, eutt RR (k1 u) (k2 u)) -> eutt RR (ITree.bind t k1) (ITree.bind t k2).
-Proof.
-  intros.
-  apply eutt_clo_bind with (UU := Logic.eq); [reflexivity |].
-  intros ? ? ->; apply H.
-Qed.
-
-(* Further specialization for [RR := eq] *)
-Lemma eutt_eq_bind' {E U R} (t1 t2: itree E U) (k1 k2: U -> itree E R):
-  t1 ≈ t2 ->
-  (forall u, (k1 u) ≈ (k2 u)) ->
-  (ITree.bind t1 k1) ≈ (ITree.bind t2 k2).
-Proof.
-  intros -> Hk. now apply eutt_eq_bind.
-Qed.
-
-(* Exposing a version specialized to [eutt] so that users don't have to know about [eqit] *)
-Lemma eutt_Ret :
-  forall E (R1 R2 : Type) (RR : R1 -> R2 -> Prop) r1 r2, RR r1 r2 <-> eutt (E := E) RR (Ret r1) (Ret r2).
-Proof.
-  intros; apply eqit_Ret.
-Qed.
-
-(* [eutt] can be thought as the elementary block of a relational program logic.
-   The following few lemmas give elementary logical rules to compose proofs.
- *)
-Lemma eutt_conj {E} {R S} {RS RS'} :
-  forall (t : itree E R) (s : itree E S),
-    eutt RS  t s ->
-    eutt RS' t s ->
-    eutt (RS /2\ RS') t s. 
-Proof.
-  repeat red.
-  einit. ecofix CIH. intros * EQ EQ'.
-  rewrite itree_eta, (itree_eta s).
-  punfold EQ; punfold EQ'; red in EQ; red in EQ'.
-  genobs t ot; genobs s os.
-  hinduction EQ before CIHH; subst; intros; pclearbot; simpl.
-
-  - estep; split; auto.
-    inv EQ'; auto.
-  - estep; ebase; right; eapply CIHL; eauto.
-    rewrite <- tau_eutt.
-    rewrite <- (tau_eutt m2); auto with itree.
-  - assert (EE := eqitF_inv_VisF _ _ _ _ _ EQ'); pclearbot.
-    eapply euttG_vis; ebase; left; apply CIHH; auto with itree.
-  - eapply fold_eqitF in EQ'; eauto.
-    assert (t ≈ Tau t1) by (rewrite itree_eta, <- Heqot; reflexivity).
-    rewrite H in EQ'.
-    apply eqit_inv_Tau_l in EQ'.
-    subst; specialize (IHEQ _ _ eq_refl eq_refl).
-    punfold EQ'; red in EQ'.
-    specialize (IHEQ EQ').
-    rewrite eqit_Tau_l; [|reflexivity].
-    rewrite (itree_eta t1).
-    eapply IHEQ. 
-  - subst; cbn.
-    rewrite tau_euttge.
-    rewrite (itree_eta t2); eapply IHEQ; eauto.
-    eapply fold_eqitF in EQ'; eauto.
-    assert (s ≈ Tau t2).
-    rewrite (itree_eta s), <- Heqos; reflexivity.
-    rewrite tau_eutt in H.
-    assert (eutt RS' t t2).
-    rewrite <- H; auto.
-    punfold H0.
-Qed.
-
-Lemma eutt_disj_l {E} {R S} {RS RS'} :
-  forall (t : itree E R) (s : itree E S),
-    eutt RS t s ->
-    eutt (RS \2/ RS') t s. 
-Proof.
-  intros.
-  eapply eqit_mon with (RR := RS); eauto.
-Qed.
-
-Lemma eutt_disj_r {E} {R S} {RS RS'} :
-  forall (t : itree E R) (s : itree E S),
-    eutt RS' t s ->
-    eutt (RS \2/ RS') t s. 
-Proof.
-  intros.
-  eapply eqit_mon with (RR := RS'); eauto.
-Qed.
-
-Lemma eutt_equiv {E} {R S} {RS RS'} :
-  forall (t : itree E R) (s : itree E S),
-    (HeterogeneousRelations.eq_rel RS RS') ->
-    eutt RS t s <-> eutt RS' t s. 
-Proof.
-  intros * EQ; split; intros EUTT; eapply eqit_mon; try apply EUTT; eauto.
-  all:apply EQ.
-Qed.
-
-(* Rewriting equivalent simulation relations under [eq_itree] and [eutt] *)
-#[global]
-Instance eq_itree_Proper_R {E : Type -> Type} {R1 R2:Type}
-  : Proper ((@HeterogeneousRelations.eq_rel R1 R2) ==> Logic.eq ==> Logic.eq ==> iff) (@eq_itree E R1 R2).
-Proof.
-  repeat intro; subst.
-  unfold eq_itree; rewrite H; reflexivity.
-Qed.
-
-#[global]
-Instance eutt_Proper_R {E : Type -> Type} {R1 R2:Type}
-  : Proper  ((@HeterogeneousRelations.eq_rel R1 R2) ==> eq ==> eq ==> iff) (@eutt E R1 R2).
-Proof.
-  repeat intro; subst.
-  unfold eutt; rewrite H; reflexivity.
-Qed.
-
-(* Stronger subrelation result which applies for [eutt RR t t]. This is
-   relevant for post-conditions *)
-Lemma eutt_sub_self {E R} (R1 R2: R -> R -> Prop) (t: itree E R):
-  (forall r, R1 r r -> R2 r r) ->
-  eutt R1 t t ->
-  eutt R2 t t.
-Proof.
-  intros Hrel; revert t. ginit. gcofix CIH; intros t Heutt.
-  punfold Heutt; red in Heutt.
-  remember t as t' in Heutt at 2. assert (Ht': t' ≈ t) by now subst. clear Heqt'.
-  rewrite (itree_eta t). rewrite (itree_eta t), (itree_eta t') in Ht'.
-  revert Ht'. induction Heutt; clear t; intros Heq.
-  - apply eutt_inv_Ret in Heq; subst.
-    gstep; constructor; auto.
-  - apply eqit_inv_Tau in Heq.
-    gstep; constructor. gfinal; left. eapply CIH.
-    rewrite <- Heq at 2. now pclearbot.
-  - gstep; constructor. intros v. eapply eqit_inv_Vis in Heq.
-    gfinal; left. apply CIH. specialize (REL v).
-    rewrite <- Heq at 2. now pclearbot.
-  - rewrite tau_euttge, (itree_eta t1). apply IHHeutt.
-    rewrite tau_euttge in Heq. rewrite <- itree_eta; auto.
-  - apply IHHeutt. rewrite tau_euttge in Heq. rewrite <- itree_eta; auto.
-Qed.
diff --git a/theories/Events/Concurrency.v b/theories/Events/Concurrency.v
index a8fd7272..072bb185 100644
--- a/theories/Events/Concurrency.v
+++ b/theories/Events/Concurrency.v
@@ -4,7 +4,7 @@
 Set Implicit Arguments.
 Set Contextual Implicit.
 
-From Coq Require Import List.
+From Stdlib Require Import List.
 Import ListNotations.
 
 From ITree Require Import
diff --git a/theories/Events/ExceptionFacts.v b/theories/Events/ExceptionFacts.v
index 0e840964..9a6039dd 100644
--- a/theories/Events/ExceptionFacts.v
+++ b/theories/Events/ExceptionFacts.v
@@ -1,11 +1,11 @@
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Morphisms.
 
 From ExtLib Require Import
      Structures.Monad.
 
-From Paco Require Import paco.
+From Coinduction Require Import all.
 
 From ITree Require Import
      ITree
@@ -17,6 +17,7 @@ Import Monads.
 Import MonadNotation.
 #[local] Open Scope monad_scope.
 
+
 Lemma try_catch_ret : forall E Err R r (kcatch : Err -> itree (exceptE Err +' E) R),
     try_catch (Ret r) kcatch ≅ Ret r.
 Proof.
@@ -45,58 +46,69 @@ Lemma try_catch_ev : forall E A Err R (ev: E A) k (kcatch : Err -> itree (except
     try_catch (Vis (inr1 ev) k ) kcatch ≅ Vis (inr1 ev) (fun x => Tau (try_catch (k x) kcatch) ).
 Proof.
   intros. unfold try_catch. unfold iter, Iter_Kleisli, Basics.iter, MonadIter_itree.
-  rewrite unfold_iter. cbn. unfold ITree.map at 3.
-  setoid_rewrite bind_bind. rewrite bind_trigger. cbn.
-  setoid_rewrite bind_ret_l. reflexivity.
+  rewrite unfold_iter. cbn. 
+  rewrite bind_map. rewrite bind_trigger. reflexivity.  
 Qed.
 
 Global Instance proper_eqitree_try_catch {E Err R} : Proper (eq_itree eq ==> pointwise_relation Err (eq_itree eq) ==> eq_itree eq) (@try_catch Err R E).
 Proof.
-  intros t1 t2 Ht k1 k2 Hk. red in Hk. generalize dependent t2. revert t1.
-  ginit. gcofix CIH. intros. unfold try_catch.  setoid_rewrite unfold_iter_ktree.
-  pinversion Ht; try inv CHECK.
-  - repeat rewrite bind_ret_l. gfinal; right. pfold; constructor; auto.
-  - repeat rewrite bind_ret_l. gstep; constructor. gfinal. left. eauto.
+  intros t1 t2 Ht k1 k2 Hk. red in Hk. revert t1 t2 Ht. 
+  coinduction. intros. unfold try_catch. setoid_rewrite unfold_iter_ktree.
+  sinv Ht. 
+  - cbn. reflexivity. 
+  - cbn. etau. 
   - destruct e.
-    + destruct e. cbn. repeat rewrite bind_map. repeat rewrite bind_ret_r.  gfinal.
-      right. eapply paco2_mon; try apply Hk. intros; contradiction.
-    + cbn. repeat rewrite bind_map. repeat rewrite bind_trigger. gstep. constructor. intros.
-      gstep. constructor. gfinal. left. eauto with itree.
+    + destruct e. bcbn. 
+      rewrite 2 bind_map. rewrite 2 bind_ret_r. 
+      step. apply Hk. 
+    + cbn. evis. step. cbn. etau. 
 Qed.
 
 Global Instance proper_eutt_try_catch {E Err R} : Proper (eutt eq ==> pointwise_relation Err (eutt eq) ==> eutt eq) (@try_catch Err R E).
 Proof.
-  intros t1 t2 Ht k1 k2 Hk. red in Hk. generalize dependent t2. revert t1.
-  ginit. gcofix CIH. intros. unfold try_catch. setoid_rewrite unfold_iter_ktree.
-  punfold Ht. red in Ht.
-  hinduction Ht before r; intros; subst; eauto; try inv CHECK; pclearbot.
-  - repeat rewrite bind_ret_l. gfinal; right. pfold; constructor; auto.
-  - repeat rewrite bind_ret_l. gstep; constructor. gfinal. left. eauto.
+  intros t1 t2 Ht k1 k2 Hk. red in Hk. revert t1 t2 Ht. 
+  coinduction. intros. unfold try_catch. setoid_rewrite unfold_iter_ktree.
+  step in Ht. 
+  hinduction Ht before c; intros; subst; eauto.
+  - cbn. reflexivity. 
+  - cbn. etau.  
   - destruct e.
-    + destruct e. cbn. repeat rewrite bind_map. repeat rewrite bind_ret_r.  gfinal.
-      right. eapply paco2_mon; try apply Hk. intros; contradiction.
-    + cbn. repeat rewrite bind_map. repeat rewrite bind_trigger. gstep. constructor. intros.
-      gstep. constructor. gfinal. left. eauto with itree.
-  - rewrite bind_ret_l. rewrite tau_euttge. rewrite unfold_iter_ktree. eapply IHHt; eauto.
-  - rewrite bind_ret_l. rewrite tau_euttge. rewrite unfold_iter_ktree. eapply IHHt; eauto.
+    + destruct e. bcbn.
+      rewrite 2 bind_map. rewrite 2 bind_ret_r. 
+      step. apply Hk. 
+    + bcbn. evis. step. cbn. etau. 
+  - cbn. taul. eapply IHHt; eauto.
+  - cbn. taur. eapply IHHt; eauto.
 Qed.
 
 
-Global Instance proper_eqitree_throw_prefix {E Err R b} : Proper (eqit eq b b ==> eqit eq b b) (@throw_prefix Err R E).
+Global Instance proper_eqitree_throw_prefix_false {E Err R} : Proper (eqit eq false false ==> eqit eq false false) (@throw_prefix Err R E).
+Proof.
+  intros t1 t2 Ht. revert t1 t2 Ht. 
+  coinduction. intros. unfold throw_prefix. setoid_rewrite unfold_iter_ktree.
+  sinv Ht.
+  - cbn. etau.
+  - destruct e.
+    + destruct e. cbn. reflexivity. 
+    + cbn. evis. step. cbn. etau. 
+Qed.
+
+Global Instance proper_eutt_throw_prefix {E Err R} : Proper (eutt eq ==> eutt eq) (@throw_prefix Err R E).
 Proof.
-  intros t1 t2 Ht. generalize dependent t2. revert t1.
-  ginit. gcofix CIH. intros. unfold throw_prefix. setoid_rewrite unfold_iter_ktree.
-  punfold Ht. red in Ht. hinduction Ht before r; intros; subst; eauto; try inv CHECK.
-  - repeat rewrite bind_ret_l. gfinal; right. subst. pfold; constructor; auto.
-  - repeat rewrite bind_ret_l. gstep; constructor. gfinal. left. pclearbot.
-    eapply CIH. auto.
+  intros t1 t2 Ht. revert t1 t2 Ht. 
+  coinduction. intros. unfold throw_prefix. setoid_rewrite unfold_iter_ktree.
+  step in Ht. hinduction Ht before c; intros; subst; eauto.
+  - cbn. etau.
   - destruct e.
-    + destruct e. cbn. repeat rewrite bind_map. repeat rewrite bind_ret_r. repeat rewrite bind_ret_l.  gfinal.
-      right. pfold; constructor; auto.
-    + cbn. repeat rewrite bind_map. repeat rewrite bind_trigger. gstep. constructor. intros.
-      gstep. constructor. gfinal. left. pclearbot. eapply CIH; eauto with itree.
-  - rewrite bind_ret_l. rewrite tau_euttge. rewrite unfold_iter_ktree. eapply IHHt; eauto.
-  - rewrite bind_ret_l. rewrite tau_euttge. rewrite unfold_iter_ktree. eapply IHHt; eauto.
+    + destruct e. cbn. reflexivity. 
+    + cbn. evis. step. cbn. etau. 
+  - cbn. taul. eapply IHHt; eauto.
+  - cbn. taur. eapply IHHt; eauto.
+Qed.
+
+Global Instance proper_eqitree_throw_prefix {E Err R b} : Proper (eqit eq b b ==> eqit eq b b) (@throw_prefix Err R E).
+Proof.
+  destruct b; [apply proper_eutt_throw_prefix | apply proper_eqitree_throw_prefix_false].
 Qed.
 
 Definition throw_prefix_ret : forall E Err R (r : R),
@@ -121,25 +133,21 @@ Qed.
 Definition throw_prefix_ev : forall X E Err R k  (e : E X) , 
     throw_prefix ((Vis (inr1 e) k : itree (exceptE Err +' E) R )) ≅ Vis (inr1 e) (fun x => Tau (throw_prefix (k x)) ).
 Proof.
-  intros. setoid_rewrite unfold_iter_ktree at 1. cbn. rewrite bind_map.
+  intros. setoid_rewrite unfold_iter_ktree at 1. cbn. rewrite bind_map. 
   rewrite bind_trigger. apply eqit_Vis. intros. reflexivity.
 Qed.
 
 Lemma try_catch_throw_prefix_nop : forall E Err R  kcatch (ttry : itree (exceptE Err +' E) R),
     try_catch (throw_prefix ttry) kcatch ≈ throw_prefix ttry.
 Proof. 
-  intros E Err R kcatch. ginit. gcofix CIH. intros.
+  intros E Err R kcatch. coinduction. intros.
   destruct (observe ttry) eqn : Heq; symmetry in Heq; apply simpobs in Heq.
-  - rewrite Heq. rewrite throw_prefix_ret. rewrite try_catch_ret. gfinal. right.
-    pfold; constructor; auto.
-  - rewrite Heq. rewrite throw_prefix_tau. rewrite try_catch_tau. gstep. constructor.
-    gfinal; left; auto.
+  - rewrite Heq. rewrite throw_prefix_ret. rewrite try_catch_ret. reflexivity.
+  - rewrite Heq. rewrite throw_prefix_tau. rewrite try_catch_tau. etau.
   - destruct e.
-   + destruct e. rewrite Heq. rewrite throw_prefix_exc. rewrite try_catch_ret. gfinal.
-     right. pfold; constructor; auto.
-   + rewrite Heq. rewrite throw_prefix_ev. rewrite try_catch_ev. gstep.
-     constructor. intros. red. rewrite try_catch_tau. repeat rewrite tau_euttge.
-     gfinal. left. auto.
+   + destruct e. rewrite Heq. rewrite throw_prefix_exc. rewrite try_catch_ret. reflexivity.
+   + rewrite Heq. rewrite throw_prefix_ev. rewrite try_catch_ev. evis.
+     rewrite try_catch_tau. repeat rewrite tau_euttge. apply CIH.
 Qed.
 
 Lemma throw_prefix_bind_decomp : forall E Err R (t : itree (exceptE Err +' E) R ),
@@ -149,16 +157,15 @@ Lemma throw_prefix_bind_decomp : forall E Err R (t : itree (exceptE Err +' E) R
                                     | inl a => Ret a
                                     end).
 Proof.
-  intros E Err R. ginit. gcofix CIH. intros.
+  intros E Err R. coinduction. intros.
   destruct (observe t) eqn : Heq; symmetry in Heq; apply simpobs in Heq.
-  - rewrite Heq. rewrite throw_prefix_ret. rewrite bind_ret_l. gfinal. right. pfold; constructor; auto.
-  - rewrite Heq. rewrite throw_prefix_tau. rewrite bind_tau. gstep. constructor.
-    gfinal; left. auto.
+  - rewrite Heq. rewrite throw_prefix_ret. rewrite bind_ret_l. eret. 
+  - rewrite Heq. rewrite throw_prefix_tau. rewrite bind_tau. etau.
   - destruct e.
-    + rewrite Heq. destruct e. rewrite throw_prefix_exc. rewrite bind_ret_l. cbn. rewrite bind_trigger.
-      gstep. constructor. intros [].
-    + rewrite Heq. rewrite throw_prefix_ev. rewrite bind_vis. gstep. constructor.
-      intros. red. rewrite tau_euttge. gfinal; left; auto.
+    + rewrite Heq. destruct e. rewrite throw_prefix_exc. rewrite bind_ret_l. bcbn. evis. 
+      easy. 
+    + rewrite Heq. rewrite throw_prefix_ev. rewrite bind_vis. evis. 
+      intros. rewrite tau_euttge. apply CIH. 
 Qed.
 
 Lemma try_catch_to_throw_prefix : forall E Err R (ttry : itree (exceptE Err +' E) R  ) (kcatch : Err -> itree (exceptE Err +' E) R),
@@ -168,37 +175,35 @@ Lemma try_catch_to_throw_prefix : forall E Err R (ttry : itree (exceptE Err +' E
                                                             | inl a => Ret a
                                                             end).
 Proof.
-  intros. revert ttry. ginit. gcofix CIH.
+  intros. revert ttry. coinduction. 
   intros. destruct (observe ttry) eqn : Heq; symmetry in Heq; apply simpobs in Heq.
-  - rewrite Heq. rewrite try_catch_ret. rewrite throw_prefix_ret. rewrite bind_ret_l. gfinal.
-    right. pfold; constructor; auto.
+  - rewrite Heq. rewrite try_catch_ret. rewrite throw_prefix_ret. rewrite bind_ret_l. 
+    eret. 
   - rewrite Heq. rewrite try_catch_tau. rewrite throw_prefix_tau. rewrite bind_tau.
-    gstep. constructor. gfinal; left; auto.
+    etau. 
   - destruct e.
     + destruct e. rewrite Heq. rewrite try_catch_exc. rewrite throw_prefix_exc. rewrite bind_ret_l.
-      gfinal; right. apply paco2_mon with (r := bot2); intros; try contradiction.
-      enough (kcatch e ≈ kcatch e); auto. reflexivity.
+      reflexivity. 
     + rewrite Heq. rewrite try_catch_ev. rewrite throw_prefix_ev. rewrite bind_vis. setoid_rewrite tau_euttge.
-      gstep. constructor. intros. gfinal. left. auto.
+      evis. 
 Qed.
 
 Lemma throw_prefix_of_try_catch :  forall E Err R (ttry : itree (exceptE Err +' E) R  ) (kcatch : Err -> itree (exceptE Err +' E) R),
     throw_prefix (try_catch ttry kcatch) ≈ try_catch (ITree.bind ttry (fun r => Ret (inl r)) ) (fun e => throw_prefix (kcatch e) ).
 Proof.
-  intros. revert ttry. ginit. gcofix CIH.
+  intros. revert ttry. coinduction. 
   intros. destruct (observe ttry) eqn : Heq; symmetry in Heq; apply simpobs in Heq.
   - rewrite Heq. rewrite bind_ret_l. repeat rewrite try_catch_ret. rewrite throw_prefix_ret.
-    gfinal; right; pfold; constructor; auto.
+    eret. 
   - rewrite Heq. rewrite bind_tau. repeat rewrite try_catch_tau. rewrite throw_prefix_tau.
-    gstep. constructor. gfinal. left. auto.
+    etau. 
   - destruct e.
     + destruct e. rewrite Heq. rewrite bind_vis. repeat rewrite try_catch_exc.
-      gfinal; right. apply paco2_mon with (r := bot2); intros; try contradiction.
-      enough (throw_prefix (kcatch e) ≈ throw_prefix (kcatch e)); auto; try reflexivity.
+      reflexivity. 
     + rewrite Heq. rewrite bind_vis. repeat rewrite try_catch_ev. rewrite throw_prefix_ev.
       setoid_rewrite throw_prefix_tau.
       repeat setoid_rewrite tau_euttge.
-      gstep. constructor. intros. gfinal. left. auto.
+      evis. 
 Qed.
 
 Lemma throw_prefix_bind : forall E Err R S (t : itree (exceptE Err +' E) R ) (k : R -> itree (exceptE Err +' E) S),
@@ -207,19 +212,17 @@ Lemma throw_prefix_bind : forall E Err R S (t : itree (exceptE Err +' E) R ) (k
                                   | inl r' => throw_prefix (k r') 
                                   | inr e => Ret (inr e) end ).
 Proof.
-  intros. revert t. ginit. gcofix CIH.
+  intros. revert t. coinduction. 
   intros. destruct (observe t) eqn : Heq; symmetry in Heq; apply simpobs in Heq.
   - rewrite Heq. rewrite throw_prefix_ret. repeat rewrite bind_ret_l.
-    gfinal; right. apply paco2_mon with (r := bot2); intros; try contradiction.
-    enough (throw_prefix (k r0) ≅ throw_prefix (k r0)); auto; try reflexivity.
+    reflexivity. 
   - rewrite Heq. rewrite throw_prefix_tau. repeat rewrite bind_tau. rewrite throw_prefix_tau.
-    gstep. constructor. gfinal; eauto.
+    etau. 
   - destruct e.
     + destruct e. rewrite Heq. rewrite throw_prefix_exc. rewrite bind_vis. rewrite throw_prefix_exc.
-      rewrite bind_ret_l. gstep; constructor; auto.
+      rewrite bind_ret_l. eret. 
     + rewrite Heq. rewrite throw_prefix_ev. repeat rewrite bind_vis. rewrite throw_prefix_ev.
-      gstep. constructor. intros. red. rewrite bind_tau. gstep. constructor.
-      gfinal. eauto.
+      evis. rewrite bind_tau. step. taus. apply CIH.  
 Qed.
 
 Lemma throw_prefix_iter : forall E Err A B (body : A -> itree (exceptE Err +' E) (A + B)  ) (init : A),
@@ -229,34 +232,32 @@ Lemma throw_prefix_iter : forall E Err A B (body : A -> itree (exceptE Err +' E)
                                                              | inl (inr b) => Ret (inr (inl b))
                                                              | inr e => Ret (inr (inr e)) end)  init.
 Proof.
-  intros E Err A B. ginit. gcofix CIH. intros.
+  intros E Err A B. coinduction. intros.
   setoid_rewrite unfold_iter_ktree at 2 3.
   destruct (observe (body init) ) eqn : Heq; symmetry in Heq; apply simpobs in Heq.
   - rewrite Heq at 1. rewrite bind_ret_l. setoid_rewrite bind_bind. 
     rewrite Heq at 1. rewrite throw_prefix_ret. rewrite bind_ret_l.
-    destruct r0; rewrite bind_ret_l.
-    + rewrite throw_prefix_tau. gstep. constructor. gfinal. eauto.
-    + rewrite throw_prefix_ret. gfinal. right. pfold; constructor; auto.
+    destruct r; rewrite bind_ret_l.
+    + rewrite throw_prefix_tau. etau. 
+    + rewrite throw_prefix_ret. reflexivity. 
   - rewrite Heq at 1. setoid_rewrite bind_bind. rewrite Heq at 1.
     rewrite throw_prefix_tau. repeat rewrite bind_tau. rewrite throw_prefix_tau.
-    gstep. constructor. setoid_rewrite throw_prefix_bind at 1. guclo eqit_clo_bind.
-    econstructor; try reflexivity. intros; subst. destruct u2 as [ [ a | b] | e ].
-    + rewrite bind_ret_l. rewrite throw_prefix_tau. gstep. constructor. gfinal. eauto.
-    + rewrite bind_ret_l. rewrite throw_prefix_ret. gstep; constructor; auto.
-    + rewrite bind_ret_l. gstep; constructor; auto.
+    etau. setoid_rewrite throw_prefix_bind at 1. ebind; intros; subst. 
+    destruct u2 as [ [ a | b] | e ].
+    + rewrite bind_ret_l. rewrite throw_prefix_tau. step; etau. 
+    + rewrite bind_ret_l. rewrite throw_prefix_ret. reflexivity. 
+    + rewrite bind_ret_l. step; eret. 
   - rewrite Heq at 1. setoid_rewrite bind_bind. rewrite Heq at 1.
     destruct e.
     + destruct e. rewrite bind_vis. rewrite throw_prefix_exc.
       setoid_rewrite throw_prefix_exc. repeat rewrite bind_ret_l.
-      gstep; constructor; auto.
+      reflexivity. 
     + rewrite bind_vis. rewrite throw_prefix_ev. setoid_rewrite throw_prefix_ev.
-      rewrite bind_vis. setoid_rewrite bind_tau. gstep; constructor. intros. red.
-      gstep; constructor. rewrite throw_prefix_bind.
-      guclo eqit_clo_bind. econstructor; try reflexivity. intros; subst.
+      rewrite bind_vis. setoid_rewrite bind_tau. evis. step; etau. 
+      rewrite throw_prefix_bind. ebind; intros; subst. 
       destruct u2 as [ [ a | b] | e' ].
-      * rewrite bind_ret_l. rewrite throw_prefix_tau. gstep; constructor.
-        gfinal. eauto.
+      * rewrite bind_ret_l. rewrite throw_prefix_tau. step; etau. 
       * rewrite bind_ret_l. rewrite throw_prefix_ret.
-        gstep; constructor; auto.
-      * rewrite bind_ret_l. gstep; constructor; auto.
+        reflexivity. 
+      * rewrite bind_ret_l. reflexivity. 
 Qed.
diff --git a/theories/Events/FailFacts.v b/theories/Events/FailFacts.v
index 113b01db..548be5da 100644
--- a/theories/Events/FailFacts.v
+++ b/theories/Events/FailFacts.v
@@ -1,10 +1,10 @@
 (** * Theorems about Failure effects *)
 
 (* begin hide *)
-From Coq Require Import
-     Morphisms.
+From Coinduction Require Import all. 
 
-From Paco Require Import paco.
+From Stdlib Require Import
+     Morphisms.
 
 From ITree Require Import
      Basics.Utils
@@ -17,8 +17,6 @@ From ITree Require Import
      Core.KTree
      Core.KTreeFacts
      Eq.Eqit
-     Eq.UpToTaus
-     Eq.Paco2
      Indexed.Sum
      Interp.Interp
      Interp.InterpFacts
@@ -101,7 +99,7 @@ Section FailTLaws.
       + eapply eutt_eq_bind; intros []; reflexivity. 
       + rewrite bind_ret_l; reflexivity.
     - repeat intro; cbn.
-      eapply eutt_clo_bind; eauto.
+      eapply eutt_bind_eutt; eauto.
       intros [] [] REL; cbn in *; subst; try contradiction.
       + apply H0.
       + reflexivity.
@@ -139,7 +137,7 @@ Proof.
   cbn; repeat (rewrite ?bind_bind, ?bind_ret_l, ?bind_map; try reflexivity).
   cbn; repeat (rewrite ?bind_bind, ?bind_ret_l, ?bind_map; try reflexivity).
   cbn; repeat (rewrite ?bind_bind, ?bind_ret_l, ?bind_map; try reflexivity).
-  apply eq_itree_clo_bind with (UU := Logic.eq); [reflexivity | intros x ? <-]. 
+  apply eq_itree_bind with (UU := Logic.eq); [reflexivity | intros x ? <-]. 
   destruct x as [x|].
   - rewrite bind_ret_l; reflexivity.
   - rewrite bind_ret_l; reflexivity.
@@ -149,14 +147,13 @@ Global Instance interp_fail_eq_itree {X E F} {R : X -> X -> Prop} (h : E ~> fail
   Proper (eq_itree R ==> eq_itree (option_rel R)) (@interp_fail _ _ _ _ _ h X).
 Proof.
   repeat red. 
-  ginit.
-  pcofix CIH.
+  coinduction. 
   intros s t EQ.
   rewrite 2 unfold_interp_fail.
-  punfold EQ; red in EQ.
-  destruct EQ; cbn; subst; try discriminate; pclearbot; try (gstep; constructor; eauto with paco; fail).
-  guclo eqit_clo_bind; econstructor; [reflexivity | intros x ? <-].
-  destruct x as [x|]; gstep; econstructor; eauto with paco itree.
+  step in EQ. 
+  destruct EQ; cbn; subst; try discriminate; eauto with itree. 
+  to_mon. ebind; intros; subst. destruct u2. 
+  etau. eret. 
 Qed.
 
 (* Convenient special case: [option_rel eq eq] is equivalent to [eq], so we can avoid bothering *)
@@ -172,16 +169,14 @@ Global Instance interp_fail_eutt {X E F R} (h : E ~> failT (itree F)) :
   Proper (eutt R ==> eutt (option_rel R)) (@interp_fail _ _ _ _ _ h X).
 Proof.
   repeat red. 
-  einit.
-  ecofix CIH.
+  coinduction. 
   intros s t EQ.
   rewrite 2 unfold_interp_fail.
-  punfold EQ; red in EQ.
-  induction EQ; intros; cbn; subst; try discriminate; pclearbot; try (estep; constructor; eauto with paco; fail).
-  - ebind; econstructor; [reflexivity |].
-    intros [] [] EQ; inv EQ.
-    + estep; ebase.
-    + eret. 
+  step in EQ. 
+  induction EQ; intros; bcbn; subst; try discriminate. 
+  - eret. 
+  - etau. 
+  - ebind; intros; subst. destruct u2; econstructor; eauto with itree.  
   - rewrite tau_euttge, unfold_interp_fail; eauto.
   - rewrite tau_euttge, unfold_interp_fail; eauto.
 Qed.
@@ -249,21 +244,17 @@ Lemma interp_fail_bind : forall {X Y E F} (t : itree _ X) (k : X -> itree _ Y) (
                 ITree.bind (interp_fail h t)
                 (fun mx => match mx with | None => ret None | Some x => interp_fail h (k x) end).
 Proof.
-  intros X Y E F; ginit; pcofix CIH; intros.
+  intros X Y E F; coinduction; intros.
   rewrite unfold_bind.
   rewrite (unfold_interp_fail h t).
-  destruct (observe t) eqn:EQ; cbn.
-  - rewrite bind_ret_l. apply reflexivity.
-  - cbn. rewrite bind_tau, !interp_fail_tau.
-    gstep. econstructor; eauto with paco.
+  destruct (observe t) eqn:EQ; bcbn.
+  - rewrite bind_ret_l. reflexivity. 
+  - taus. apply CIH. 
   - rewrite bind_bind, interp_fail_vis.
-    guclo eqit_clo_bind; econstructor.
-    reflexivity.
-    intros [] ? <-; cbn.
+    ebind; intros; subst.  
+    destruct u2. 
     + rewrite bind_tau.
-      gstep; constructor.
-      ITree.fold_subst.
-      auto with paco.
+      etau. 
     + rewrite bind_ret_l.
       apply reflexivity.
 Qed.
@@ -276,21 +267,16 @@ Lemma interp_failure_bind' : forall {X Y E F} (t : itree _ X) (k : X -> itree _
 Proof.
   intros X Y E F.
   cbn.
-  ginit; pcofix CIH; intros.
-  cbn in *.
+  coinduction; intros.  
   rewrite unfold_bind, (unfold_interp_fail _ t).
-  destruct (observe t) eqn:EQ; cbn.
-  - rewrite bind_ret_l. apply reflexivity.
-  - rewrite bind_tau, !interp_fail_tau.
-    gstep. econstructor; eauto with paco.
+  destruct (observe t) eqn:EQ; bcbn.
+  - rewrite bind_ret_l. reflexivity. 
+  - etau. apply CIH. 
   - rewrite bind_bind, interp_fail_vis.
-    guclo eqit_clo_bind; econstructor.
-    reflexivity.
-    intros [] ? <-; cbn.
+    ebind; intros; subst. 
+    destruct u2. 
     + rewrite bind_tau.
-      gstep; constructor.
-      ITree.fold_subst.
-      auto with paco.
+      etau. 
     + rewrite bind_ret_l.
-      apply reflexivity.
+      reflexivity.
 Qed.
diff --git a/theories/Events/Map.v b/theories/Events/Map.v
index 64f6b904..0b55e242 100644
--- a/theories/Events/Map.v
+++ b/theories/Events/Map.v
@@ -4,7 +4,7 @@
 Set Implicit Arguments.
 Set Contextual Implicit.
 
-From Coq Require Import List.
+From Stdlib Require Import List.
 Import ListNotations.
 
 From ExtLib.Structures Require Maps.
diff --git a/theories/Events/MapDefaultFacts.v b/theories/Events/MapDefaultFacts.v
index 7829dc30..38badfd4 100644
--- a/theories/Events/MapDefaultFacts.v
+++ b/theories/Events/MapDefaultFacts.v
@@ -1,10 +1,12 @@
 (** * Mutable map whose lookup operation provides a default value.*)
 
 (* begin hide *)
+From Coinduction Require Import all. 
+
 Set Implicit Arguments.
 Set Contextual Implicit.
 
-From Coq Require Import Morphisms.
+From Stdlib Require Import Morphisms.
 
 From ExtLib Require Import
      Core.RelDec.
@@ -12,13 +14,10 @@ From ExtLib Require Import
 From ExtLib.Structures Require
      Maps.
 
-From Paco Require Import paco.
-
 From ITree Require Import
      Basics.HeterogeneousRelations
      ITree
      ITreeFacts
-     Eq.Paco2
      Events.State
      Events.StateFacts
      Events.MapDefault.
@@ -179,23 +178,20 @@ Section MapFacts.
   Proof.
     unfold map_default_eq, interp_map; intros.
     revert t s1 s2 H.
-    ginit.
-    pcofix CH.
+    coinduction. 
     intros.
     repeat rewrite unfold_interp_state. unfold _interp_state.
     destruct (observe t).
-    - gstep. constructor. constructor; auto.
-    - gstep. constructor. gbase. apply CH. assumption.
-    - guclo eqit_clo_bind. econstructor.
+    - eret. 
+    - etau. 
+    - ebind. 
       unfold pure_state.
       destruct e.
-      + cbn. eapply eqit_mon; [ exact (fun x => x) .. | | apply handle_map_eq; assumption ].
-        auto. auto. intros.  apply PR.
-      + cbn. apply eqit_Vis. intros.  apply eqit_Ret. constructor; auto.
+      + cbn. step. now eapply handle_map_eq. 
+      + cbn. evis. step; eret. 
       + intros. destruct u1. destruct u2. cbn.
-        destruct H as [H1 H2]; cbn in H1, H2; subst.
-        gstep; constructor.
-        gbase. apply CH. assumption.
+        destruct H0 as [H1 H2]; cbn in H1, H2; subst.
+        etau. 
   Qed.
  
   Global Instance interp_map_proper {R E d} {RR : R -> R -> Prop} :
@@ -204,29 +200,25 @@ Section MapFacts.
     unfold map_default_eq, interp_map.
     repeat intro.
     revert x y H s1 s2 H0.
-    einit.
-    ecofix CH.
+    coinduction. 
     intros.
     rewrite! unfold_interp_state. 
-    punfold H0. red in H0.
-    revert s1 s2 H1.
-    induction H0; intros; subst; simpl; pclearbot.
+    step in H. 
+    revert s1 s2 H0.
+    induction H; intros; subst; bcbn. 
     - eret. 
     - etau.
     - ebind.
-      apply pbc_intro_h with (RU := prod_rel (@eq_map _ _ _ _ d) eq).
-      { (* SAZ: I must be missing some lemma that should solve this case *)
-        unfold case_. unfold Case_sum1, case_sum1.
-        destruct e. apply handle_map_eq. assumption.
-        unfold pure_state.
-        pstep. econstructor. intros. constructor. pfold. econstructor. constructor; auto.
-      } 
-      intros. destruct H as [HH1 ->].
-      estep; constructor. ebase.
+      + unfold case_. unfold Case_sum1, case_sum1.
+        do 2 step. destruct e.
+        * apply handle_map_eq. assumption.
+        * unfold pure_state. step. evis. step. eret. 
+      + intros. etau. 
+      inv H. rewrite snd_rel. eapply CIH; eauto. apply REL.
     - rewrite tau_euttge, unfold_interp_state.
-      eauto.
+      now eapply IHeqitF. 
     - rewrite tau_euttge, unfold_interp_state.
-      eauto.
+      now eapply IHeqitF. 
   Qed.
 
 End MapFacts.
diff --git a/theories/Events/Nondeterminism.v b/theories/Events/Nondeterminism.v
index ad9f494a..b498e6ce 100644
--- a/theories/Events/Nondeterminism.v
+++ b/theories/Events/Nondeterminism.v
@@ -6,7 +6,7 @@
 Set Implicit Arguments.
 Set Contextual Implicit.
 
-From Coq Require Import List.
+From Stdlib Require Import List.
 Import ListNotations.
 
 From ITree Require Import
diff --git a/theories/Events/Reader.v b/theories/Events/Reader.v
index 5acacbae..d2c9a825 100644
--- a/theories/Events/Reader.v
+++ b/theories/Events/Reader.v
@@ -6,7 +6,7 @@
 Set Implicit Arguments.
 Set Contextual Implicit.
 
-From Coq Require Import List.
+From Stdlib Require Import List.
 Import ListNotations.
 
 From ITree Require Import
diff --git a/theories/Events/StateFacts.v b/theories/Events/StateFacts.v
index 09d190a3..93ddcf33 100644
--- a/theories/Events/StateFacts.v
+++ b/theories/Events/StateFacts.v
@@ -1,9 +1,11 @@
 (** * Theorems about State effects *)
 
 (* begin hide *)
-From Coq Require Import Program.Tactics Morphisms.
 
-From Paco Require Import paco.
+From Coinduction Require Import all. 
+
+From Stdlib Require Import Program.Tactics Morphisms.
+
 
 From ITree Require Import
      Basics.Basics
@@ -15,8 +17,6 @@ From ITree Require Import
      Core.KTree
      Core.KTreeFacts
      Eq.Eqit
-     Eq.UpToTaus
-     Eq.Paco2
      Indexed.Sum
      Interp.Interp
      Interp.InterpFacts
@@ -61,15 +61,14 @@ Instance eq_itree_interp_state {E F S R} (h : E ~> Monads.stateT S (itree F)) :
          (@interp_state _ _ _ _ _ _ h R).
 Proof.
   revert_until R.
-  ginit. pcofix CIH. intros h x y H0 x2 _ [].
+  coinduction. intros h x y H0 x2 _ [].
   rewrite !unfold_interp_state.
-  punfold H0; repeat red in H0.
-  destruct H0; subst; pclearbot; try discriminate; cbn.
-  - gstep; constructor; auto.
-  - gstep; constructor; auto with paco.
-  - guclo eqit_clo_bind. econstructor.
-    + reflexivity.
-    + intros [] _ []. gstep; constructor; auto with paco itree.
+  step in H0. 
+  destruct H0; subst; try discriminate; cbn.
+  - reflexivity. 
+  - taus; now apply CIH.  
+  - to_mon. ebind; intros; subst.  
+    + taus; auto with itree. 
 Qed.
 
 Lemma interp_state_ret {E F : Type -> Type} {R S : Type}
@@ -126,23 +125,18 @@ Lemma interp_state_bind {E F : Type -> Type} {A B S : Type}
   (interp_state f t s >>= fun st => interp_state f (k (snd st)) (fst st)).
 Proof.
   revert t k s.
-  ginit. pcofix CIH.
+  coinduction. 
   intros t k s.
   rewrite unfold_bind.
   rewrite (unfold_interp_state f t).
   destruct (observe t).
-  - cbn. rewrite !bind_ret_l. cbn.
+  - bcbn. rewrite !bind_ret_l. 
     apply reflexivity.
-  - cbn. rewrite !bind_tau, interp_state_tau.
-    gstep. econstructor. gbase. apply CIH.
-  - cbn. rewrite interp_state_vis, bind_bind.
-    guclo eqit_clo_bind. econstructor.
-    + reflexivity.
-    + intros u2 ? [].
+  - bcbn. taus. apply CIH.
+  - bcbn. rewrite interp_state_vis, bind_bind.
+    ebind; intros; subst. 
       rewrite bind_tau.
-      gstep; constructor.
-      ITree.fold_subst.
-      auto with paco.
+      taus. now apply CIH. 
 Qed.
 
 #[global]
@@ -151,15 +145,13 @@ Instance eutt_interp_state {E F: Type -> Type} {S : Type}
   Proper (eutt RR ==> eq ==> eutt (prod_rel eq RR)) (@interp_state E (itree F) S _ _ _ h R).
 Proof.
   repeat intro. subst. revert_until RR.
-  einit. ecofix CIH. intros.
+  coinduction. intros.
 
-  rewrite !unfold_interp_state. punfold H0. red in H0.
-  induction H0; intros; subst; simpl; pclearbot.
-  - eret.
-  - etau.
-  - ebind. econstructor; [reflexivity|].
-    intros; subst.
-    etau. ebase.
+  rewrite !unfold_interp_state. step in H. 
+  induction H; intros; subst; bcbn. 
+  - eret. 
+  - etau. 
+  - ebind; intros; subst. taus. apply CIH. apply REL. 
   - rewrite tau_euttge, unfold_interp_state; eauto.
   - rewrite tau_euttge, unfold_interp_state; eauto.
 Qed.
@@ -170,15 +162,13 @@ Instance eutt_interp_state_eq {E F: Type -> Type} {S : Type}
   Proper (eutt eq ==> eq ==> eutt eq) (@interp_state E (itree F) S _ _ _ h R).
 Proof.
   repeat intro. subst. revert_until R.
-  einit. ecofix CIH. intros.
+  coinduction. intros. 
 
-  rewrite !unfold_interp_state. punfold H0. red in H0.
-  induction H0; intros; subst; simpl; pclearbot.
-  - eret.
-  - etau.
-  - ebind. econstructor; [reflexivity|].
-    intros; subst.
-    etau. ebase.
+  rewrite !unfold_interp_state. step in H. 
+  induction H; intros; subst; bcbn; eauto with itree. 
+  - eret. 
+  - ebind. intros; subst.
+    etau.
   - rewrite tau_euttge, unfold_interp_state; eauto.
   - rewrite tau_euttge, unfold_interp_state; eauto.
 Qed.
@@ -200,14 +190,14 @@ Lemma eutt_interp_state_aloop {E F S I I' A A'}
           (interp_state h (ITree.iter t2 i') s2)).
 Proof.
   intro Ht.
-  einit. ecofix CIH. intros.
+  coinduction. intros.
   rewrite 2 unfold_iter.
   rewrite 2 interp_state_bind.
-  ebind; econstructor.
-  - eapply Ht; auto.
-  - intros [s1' i1'] [s2' i2'] [? []]; cbn.
-    + rewrite 2 interp_state_tau. auto with paco.
-    + rewrite 2 interp_state_ret. auto with paco.
+  ebind; intros; subst. 
+  - do 2 step. eapply Ht; auto.
+  - inv H1. inv snd_rel.
+    + rewrite 2 interp_state_tau. etau. 
+    + rewrite 2 interp_state_ret. eret. 
 Qed.
 
 Lemma eutt_interp_state_iter {E F S A A' B B'}
@@ -235,17 +225,15 @@ Lemma eutt_eq_interp_state_iter {E F S} (f: E ~> stateT S (itree F)) {I A}
     Basics.iter (fun i => interp_state f (t i)) i s.
 Proof.
   unfold Basics.iter, MonadIter_stateT0, Basics.iter, MonadIter_itree in *; cbn.
-  ginit. gcofix CIH; intros i s.
-  rewrite 2 unfold_iter; cbn.
+  coinduction; intros i s.
+  rewrite 2 unfold_iter; bcbn.
   rewrite !bind_bind.
   setoid_rewrite bind_ret_l.
   rewrite interp_state_bind.
-  guclo eqit_clo_bind; econstructor; eauto. reflexivity.
-  intros [s' []] _ []; cbn.
-  - rewrite interp_state_tau.
-    gstep; constructor.
-    auto with paco.
-  - rewrite interp_state_ret; apply reflexivity.
+  ebind.
+  intros [s' []] _ []; bcbn.
+  - etau. 
+  - eret. 
 Qed.
 
 Lemma eutt_interp_state_loop {E F S A B C} (RS : S -> S -> Prop)
@@ -266,16 +254,14 @@ Proof.
   eapply (eutt_interp_state_iter eq eq); auto; intros.
   rewrite 2 interp_state_bind.
   subst.
-  eapply eutt_clo_bind; eauto.
+  eapply eutt_bind_eutt; eauto.
   intros.
   cbn in H2; destruct H2 as [H21 H22].
   destruct (snd u1); rewrite <- H22.
   - rewrite bind_ret_l, 2 interp_state_ret.
-    pstep.
-    constructor.
-    split; cbn; auto using H21.
-  - rewrite bind_ret_l, 2 interp_state_ret. pstep. constructor.
-    split; cbn; auto using H21.
+    step. 
+    eret. 
+  - rewrite bind_ret_l, 2 interp_state_ret. step. eret. 
 Qed.
 
 (* SAZ: These are probably too specialized. *)
@@ -291,18 +277,16 @@ Lemma interp_state_iter {E F } S (f : E ~> stateT S (itree F)) {I A}
                   (Basics.iter t' i).
 Proof.
   unfold Basics.iter, MonadIter_stateT0, Basics.iter, MonadIter_itree in *; cbn.
-  ginit. pcofix CIH; intros i s.
-  rewrite 2 unfold_iter; cbn.
+  coinduction; intros i s.
+  rewrite 2 unfold_iter; bcbn.
   rewrite !bind_bind.
   setoid_rewrite bind_ret_l.
   rewrite interp_state_bind.
-  guclo eqit_clo_bind; econstructor; eauto.
-  - apply EQ_t.
-  - intros [s' []] _ []; cbn.
-    + rewrite interp_state_tau.
-      gstep; constructor.
-      auto with paco.
-    + rewrite interp_state_ret; apply reflexivity.
+  ebind. 
+  - do 2 step. apply EQ_t.
+  - intros [s' []] _ []; bcbn.
+    + etau. 
+    + eret. 
 Qed.
 
 Lemma interp_state_iter' {E F } S (f : E ~> stateT S (itree F)) {I A}
@@ -322,16 +306,14 @@ Lemma interp_state_iter'_eutt {E F S} (f: E ~> stateT S (itree F)) {I A}
   forall i s, interp_state f (ITree.iter t i) s ≈ Basics.iter t' i s.
 Proof.
   unfold Basics.iter, MonadIter_stateT0, Basics.iter, MonadIter_itree in *; cbn.
-  ginit. gcofix CIH; intros i s.
-  rewrite 2 unfold_iter; cbn.
+  coinduction; intros i s.
+  rewrite 2 unfold_iter; bcbn.
   rewrite !bind_bind.
   setoid_rewrite bind_ret_l.
   rewrite interp_state_bind.
-  guclo eqit_clo_bind; econstructor; eauto.
-  - apply Heq.
-  - intros [s' []] _ []; cbn.
-    + rewrite interp_state_tau.
-      gstep; constructor.
-      auto with paco.
-    + rewrite interp_state_ret; apply reflexivity.
+  ebind. 
+  - do 2 step. apply Heq.
+  - intros [s' []] _ []; bcbn.
+    + etau. 
+    + eret. 
 Qed.
diff --git a/theories/Events/Writer.v b/theories/Events/Writer.v
index 9cbff741..6aeebf80 100644
--- a/theories/Events/Writer.v
+++ b/theories/Events/Writer.v
@@ -6,7 +6,7 @@
 Set Implicit Arguments.
 Set Contextual Implicit.
 
-From Coq Require Import
+From Stdlib Require Import
      List.
 Import ListNotations.
 
diff --git a/theories/ITree.v b/theories/ITree.v
index 401bbbad..d6afe3bb 100644
--- a/theories/ITree.v
+++ b/theories/ITree.v
@@ -14,7 +14,6 @@ From ITree Require Export
      Core.ITreeDefinition
      Core.KTree
      Core.Subevent
-     Eq.UpToTaus
      Indexed.Function
      Indexed.Sum
      Interp.Interp
diff --git a/theories/Indexed/FunctionFacts.v b/theories/Indexed/FunctionFacts.v
index 4ceeb06b..f8ab4696 100644
--- a/theories/Indexed/FunctionFacts.v
+++ b/theories/Indexed/FunctionFacts.v
@@ -1,7 +1,7 @@
 (** * Theorems for [ITree.Indexed.Function] *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Setoid
      Morphisms.
 
diff --git a/theories/Indexed/Relation.v b/theories/Indexed/Relation.v
index 39c1e19f..3d2b0f67 100644
--- a/theories/Indexed/Relation.v
+++ b/theories/Indexed/Relation.v
@@ -1,7 +1,7 @@
 (** * Relations on indexed types *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Relations
      Setoid.
 
diff --git a/theories/Interp/Handler.v b/theories/Interp/Handler.v
index 2518dc8c..c22e3e48 100644
--- a/theories/Interp/Handler.v
+++ b/theories/Interp/Handler.v
@@ -4,7 +4,7 @@
     form a category. *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Morphisms.
 
 From ITree Require Import
@@ -12,7 +12,6 @@ From ITree Require Import
      Basics.Category
      Core.ITreeDefinition
      Eq.Eqit
-     Eq.UpToTaus
      Indexed.Sum
      Indexed.Relation
      Interp.Interp
diff --git a/theories/Interp/HandlerFacts.v b/theories/Interp/HandlerFacts.v
index 435a7647..c24becb4 100644
--- a/theories/Interp/HandlerFacts.v
+++ b/theories/Interp/HandlerFacts.v
@@ -1,19 +1,17 @@
 (** * Theorems for [ITree.Interp.Handler] *)
-
 (* begin hide *)
-From Coq Require Import
+
+From Coinduction Require Import all. 
+From Stdlib Require Import
      Setoid
      Morphisms
      RelationClasses.
 
-From Paco Require Import paco.
-
 From ITree Require Import
      Basics.Basics
      Basics.Category
      Core.ITreeDefinition
      Eq.Eqit
-     Eq.UpToTaus
      Indexed.Sum
      Interp.Interp
      Interp.Handler
@@ -149,51 +147,56 @@ Proof.
     (* h is pretty big and duplicating it slows down the display of the goal,
        so we try to rewrite with EQh only when necessary. *)
   end.
-  remember (Tau (f T a0)) as t eqn:tmp_t. clear tmp_t.
-  revert t; einit; ecofix CIH; intros t.
+  remember (Tau (f T a0)) as t eqn:tmp_t. clear tmp_t. 
+  (* eutt needs to be transparent for coinductive unfolding to work *)
+  Local Transparent eutt.
+
+  revert t; coinduction; intros t.
   rewrite (itree_eta t).
   destruct (observe t).
-  - rewrite unfold_interp_mrec; cbn.
+  - rewrite unfold_interp_mrec. bcbn. 
     rewrite 2 interp_ret.
     rewrite unfold_interp_mrec.
     reflexivity.
-  - rewrite unfold_interp_mrec; cbn.
+  - rewrite unfold_interp_mrec. bcbn. 
     rewrite 2 interp_tau.
     rewrite (unfold_interp_mrec _ _ (Tau _)); cbn.
-    estep.
-  - rewrite unfold_interp_mrec; cbn.
+    now taus. 
+  - rewrite unfold_interp_mrec. bcbn.
     rewrite interp_vis.
-    destruct e; cbn.
+    destruct e; bcbn.
     + rewrite interp_tau.
       rewrite 2 interp_mrec_bind, interp_bind.
-      subst h; cbn.
+      subst h. 
+      bcbn.
       rewrite interp_trigger.
-      rewrite unfold_interp_mrec; cbn.
-      rewrite interp_mrec_trigger; cbn.
+      rewrite unfold_interp_mrec.  bcbn. 
+      rewrite interp_mrec_trigger. bcbn. 
       unfold Recursion.mrec.
+      (* TOUR: Note that if you eta-expand the second tree (as before), 
+      the next 3 tactics take 8 seconds each. *)
       rewrite !interp_tau.
-      rewrite (unfold_interp_mrec _ _ (Tau _)); cbn.
+      rewrite (unfold_interp_mrec _ _ (Tau _)); bcbn.
       rewrite !bind_tau.
-      etau. rewrite tau_euttge, <- interp_bind, <- 2 interp_mrec_bind.
+      taus. rewrite tau_euttge, <- interp_bind, <- 2 interp_mrec_bind.
       setoid_rewrite (tau_euttge (interp _ _)).
       rewrite <- interp_bind.
-      auto with paco.
+      auto.
     + rewrite interp_vis.
       rewrite interp_mrec_bind.
-      subst h; cbn.
-      Local Transparent eutt.
-      ebind. apply (pbc_intro_h _ _ _ _ _ eq).
-      { rewrite interp_mrec_as_interp, interp_interp.
+      subst h; bcbn.
+      ebind. instantiate (1:=eq). 
+      { do 2 step. rewrite interp_mrec_as_interp, interp_interp.
         rewrite <- interp_id_h at 1.
         eapply eutt_interp; try reflexivity.
         intros ? ?.
         rewrite interp_trigger; cbn.
         reflexivity. }
       intros ? _ [].
-      rewrite (unfold_interp_mrec _ _ (Tau _)); cbn.
-      etau.
+      rewrite (unfold_interp_mrec _ _ (Tau _)); bcbn.
+      taus. 
       rewrite tau_euttge.
-      auto with paco.
+      apply CIH. 
 Qed.
 
 Section DinatSimulation.
@@ -223,42 +226,42 @@ Theorem interleaved_mrec : forall t1 t2,
     interleaved t1 t2 ->
     Recursion.interp_mrec (cat f (case_ g inr_)) t1
   ≈ Recursion.interp_mrec (cat g (case_ f inr_)) t2.
-Proof.
-  einit; ecofix CIH; intros.
-  induction H0.
-  - rewrite 2 unfold_interp_mrec; cbn. estep.
+Proof with eauto with itree. 
+  coinduction; intros.
+  induction H.
+  - rewrite 2 unfold_interp_mrec; bcbn. reflexivity.  
   - rewrite (itree_eta t); destruct (observe t).
     + rewrite interp_ret, 2 bind_ret_l. auto.
-    + rewrite interp_tau, 2 bind_tau, 2 unfold_interp_mrec; cbn.
-      estep.
+    + rewrite interp_tau, 2 bind_tau, 2 unfold_interp_mrec; bcbn.
+      taus...  
     + rewrite interp_vis, bind_vis.
       rewrite bind_bind.
-      rewrite (unfold_interp_mrec _ _ (Vis _ _)); cbn.
-      destruct e; cbn. setoid_rewrite (tau_euttge (interp _ _)).
+      rewrite (unfold_interp_mrec _ _ (Vis _ _)); bcbn.
+      destruct e; bcbn. setoid_rewrite (tau_euttge (interp _ _)).
       * unfold cat at 3, Cat_Handler at 3, Handler.cat.
         change (g X b) with (Tau (g0 X b)).
-        rewrite bind_tau, unfold_interp_mrec; cbn.
-        etau. rewrite tau_euttge. ebase.
+        rewrite bind_tau, unfold_interp_mrec; bcbn.
+        taus. rewrite tau_euttge...
       * unfold inr_, Inr_sum1_Handler, Handler.inr_, Handler.htrigger.
         rewrite bind_trigger.
-        rewrite unfold_interp_mrec; cbn.
-        evis; intros; etau. rewrite tau_euttge. ebase.
+        rewrite unfold_interp_mrec; bcbn.
+        constructor; intros. repeat rewrite tau_euttge... 
   - rewrite (itree_eta t); destruct (observe t).
     + rewrite interp_ret, 2 bind_ret_l. auto.
-    + rewrite interp_tau, 2 bind_tau, 2 unfold_interp_mrec; cbn.
-      estep.
+    + rewrite interp_tau, 2 bind_tau, 2 unfold_interp_mrec; bcbn.
+      taus...  
     + rewrite interp_vis, bind_vis.
       rewrite bind_bind.
-      rewrite (unfold_interp_mrec _ _ (Vis _ _)); cbn.
-      destruct e; cbn. setoid_rewrite (tau_euttge (interp _ _)).
+      rewrite (unfold_interp_mrec _ _ (Vis _ _)); bcbn.
+      destruct e; bcbn. setoid_rewrite (tau_euttge (interp _ _)).
       * unfold cat at 2, Cat_Handler at 2, Handler.cat.
         change (f X a) with (Tau (f0 X a)).
-        rewrite !bind_tau, (unfold_interp_mrec _ _ (Tau _)); cbn.
-        etau. rewrite tau_euttge. ebase.
+        rewrite !bind_tau, (unfold_interp_mrec _ _ (Tau _)); bcbn.
+        taus. rewrite tau_euttge... 
       * unfold inr_, Inr_sum1_Handler, Handler.inr_, Handler.htrigger.
         rewrite bind_trigger.
-        rewrite unfold_interp_mrec; cbn.
-        evis; intros; etau. rewrite tau_euttge. ebase.
+        rewrite unfold_interp_mrec; bcbn.
+        constructor; intros. repeat rewrite tau_euttge...
 Qed.
 
 End DinatSimulation.
@@ -324,29 +327,33 @@ Proof.
         apply euttge_interp; try reflexivity.
       apply tau_euttge.
   }
-  revert t. einit; ecofix CIH. intros.
-  rewrite (itree_eta t); destruct (observe t); cbn.
-  all: rewrite (unfold_interp_mrec _ _ (go _)), unfold_interp; cbn.
-  1,2: rewrite unfold_interp_mrec; cbn.
-  1,2: rewrite (unfold_interp_mrec _ _ (go _)); estep.
+  Local Transparent eutt. 
+
+  revert t. coinduction; intros. 
+  rewrite (itree_eta t); destruct (observe t); bcbn.
+  all: rewrite (unfold_interp_mrec _ _ (go _)), unfold_interp; bcbn.
+  1,2: rewrite unfold_interp_mrec; bcbn.
+  1,2: rewrite (unfold_interp_mrec _ _ (go _)); eauto with itree.
+  taus. apply CIH. 
   destruct e.
   - rewrite (interp_mrec_bind _ (ITree.trigger _)).
-    rewrite interp_mrec_trigger; cbn.
+    rewrite interp_mrec_trigger; bcbn.
     unfold Recursion.mrec.
     remember (f X a0) as fxa eqn:Hfxa; unfold f in Hfxa; subst fxa.
-    rewrite interp_tau, unfold_interp_mrec; cbn.
-    rewrite (unfold_interp_mrec _ _ (Tau _)); cbn.
+    rewrite interp_tau, unfold_interp_mrec; bcbn.
+    rewrite (unfold_interp_mrec _ _ (Tau _)); bcbn.
     rewrite !bind_tau.
-    etau.
+    taus. 
     rewrite tau_euttge. setoid_rewrite tau_euttge.
     rewrite <- interp_mrec_bind, <- interp_bind.
-    auto with paco.
+    auto.
   - rewrite bind_trigger.
     setoid_rewrite tau_euttge.
-    rewrite 2 unfold_interp_mrec; cbn.
-    destruct s; estep.
+    rewrite 2 unfold_interp_mrec; bcbn.
+    destruct s. taus. 
     rewrite <- interp_mrec_bind, <- interp_bind.
-    auto with paco.
+    apply CIH. 
+    constructor; intros. now step; taus.  
 Qed.
 
 Global Instance Iterative_Handler : Iterative Handler sum1.
diff --git a/theories/Interp/InterpFacts.v b/theories/Interp/InterpFacts.v
index 641fb146..05d6f76c 100644
--- a/theories/Interp/InterpFacts.v
+++ b/theories/Interp/InterpFacts.v
@@ -7,13 +7,13 @@
  *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Program
      Setoid
      Morphisms
      RelationClasses.
 
-From Paco Require Import paco.
+From Coinduction Require Import all. 
 
 From ITree Require Import
      Basics.Basics
@@ -25,8 +25,6 @@ From ITree Require Import
      Core.KTreeFacts
      Eq.Shallow
      Eq.Eqit
-     Eq.UpToTaus
-     Eq.Paco2
      Indexed.Sum
      Indexed.Function
      Indexed.Relation
@@ -118,14 +116,15 @@ Instance eq_itree_interp {E F}
             interp.
 Proof.
   intros f g Hfg T.
-  ginit. pcofix CIH.
-  intros l r0 Hlr.
+  coinduction c CIH. intros. 
   rewrite 2 unfold_interp.
-  punfold Hlr; red in Hlr.
-  destruct Hlr; cbn; subst; try discriminate; pclearbot; try (gstep; constructor; eauto with paco; fail).
-  guclo eqit_clo_bind. econstructor; [eapply Hfg|].
-  intros ? _ [].
-  gstep; econstructor; eauto with paco itree.
+  step in H. 
+
+  destruct H; cbn; subst; try easy; eauto with itree.
+  unfold eq_Handler, i_pointwise in Hfg. 
+  rewrite Hfg.
+  to_mon.  
+  ebind. intros ??[=<-]. etau. 
 Qed.
 
 #[global]
@@ -145,18 +144,15 @@ Instance eutt_interp (E F : Type -> Type)
 Proof.
   repeat red.
   intros until T.
-  ginit. pcofix CIH. intros.
-
-  rewrite !unfold_interp. punfold H1. red in H1.
-  induction H1; intros; subst; pclearbot; simpl.
-  - gstep. constructor. eauto.
-  - gstep. constructor. eauto with paco.
-  - guclo eqit_clo_bind; econstructor; [apply H|].
-    intros; subst.
-    gstep; constructor; eauto with paco itree.
-  - rewrite tau_euttge, unfold_interp. auto.
-  - rewrite tau_euttge, unfold_interp. auto.
-Qed.
+  coinduction. intros.
+  rewrite !unfold_interp. step in H0. 
+  induction H0; intros; subst; cbn; eauto with itree; to_mon.   
+  eapply eqit_bind_chain. 
+  - do 2 step. apply H. 
+  - intros ??[=<-]. taus; eauto with itree. 
+  - taul. to_mon. rewrite unfold_interp. apply IHeqitF. 
+  - taur. to_mon. rewrite unfold_interp. apply IHeqitF. 
+Qed. 
 
 #[global]
 Instance euttge_interp (E F : Type -> Type)
@@ -167,17 +163,13 @@ Instance euttge_interp (E F : Type -> Type)
 Proof.
   repeat red.
   intros until T.
-  ginit. pcofix CIH. intros.
-
-  rewrite !unfold_interp. punfold H1. red in H1.
-  induction H1; intros; subst; pclearbot; simpl.
-  - gstep. constructor. eauto.
-  - gstep. constructor. eauto with paco.
-  - guclo eqit_clo_bind; econstructor; [apply H|].
-    intros; subst.
-    gstep; constructor; eauto with paco itree.
-  - rewrite tau_euttge, unfold_interp. auto.
-  - discriminate.
+  coinduction. intros.
+  rewrite !unfold_interp. step in H0. 
+  induction H0; intros; subst; cbn; try easy; eauto with itree; to_mon.
+  eapply eqit_bind_chain. 
+  - do 2 step. apply H. 
+  - intros ??[=<-]. taus; eauto with itree. 
+  - taul. to_mon. rewrite unfold_interp. apply IHeqitF. 
 Qed.
 
 #[global]
@@ -186,18 +178,13 @@ Instance eutt_interp' {E F : Type -> Type} {R : Type} (RR: R -> R -> Prop) (f :
          (@interp E (itree F) _ _ _ f R).
 Proof.
   repeat red.
-  einit.
-  ecofix CIH. intros.
+  coinduction. intros.
   rewrite !unfold_interp.
-  punfold H0.
-  induction H0; intros; subst; pclearbot; simpl.
-  - estep.
-  - estep.
-  - ebind; econstructor.
-    + reflexivity.
-    + intros; subst. estep. ebase.
-  - rewrite tau_euttge, unfold_interp. eauto.
-  - rewrite tau_euttge, unfold_interp. eauto.
+  step in H.
+  induction H; cbn; try easy; eauto with itree; to_mon. 
+  - ebind. intros; subst; taus; eauto with itree. 
+  - rewrite unfold_interp. now taul. 
+  - rewrite unfold_interp. now taur. 
 Qed.
 
 #[global]
@@ -232,16 +219,14 @@ Lemma interp_bind {E F R S}
     interp f (ITree.bind t k)
   ≅ ITree.bind (interp f t) (fun r => interp f (k r)).
 Proof.
-  revert R t k. ginit. pcofix CIH; intros.
+  revert R t k. coinduction; intros. 
   rewrite unfold_bind, (unfold_interp t).
-  destruct (observe t); cbn.
+  destruct (observe t); cbn; to_mon. 
   - rewrite bind_ret_l. apply reflexivity.
-  - rewrite bind_tau, !interp_tau.
-    gstep. econstructor. eauto with paco.
-  - rewrite interp_vis, bind_bind.
-    guclo eqit_clo_bind; econstructor; try reflexivity.
+  - taus. fold_subst. apply CIH. 
+  - rewrite interp_vis, bind_bind. ebind. 
     intros; subst.
-    rewrite bind_tau. gstep; constructor; eauto with paco.
+    rewrite bind_tau. taus. apply CIH. 
 Qed.
 
 #[global] Hint Rewrite @interp_bind : itree.
@@ -251,23 +236,24 @@ Qed.
 Lemma interp_id_h {A R} (t : itree A R)
   : interp (id_ A) t ≳ t.
 Proof.
-  revert t. ginit. pcofix CIH. intros.
+  revert t. coinduction. intros.
   rewrite (itree_eta t), unfold_interp.
-  destruct (observe t); try (gstep; constructor; auto with paco).
-  cbn. gstep. red; cbn. constructor; red; intros.
-  ITree.fold_subst.
-  rewrite bind_ret_l, tau_euttge. eauto with paco.
+  destruct (observe t); cbn.  
+  - reflexivity. 
+  - taus. apply CIH. 
+  - constructor. intro. fold_subst.
+  rewrite bind_ret_, tau_euttge. apply CIH. 
 Qed.
 
 Lemma interp_trigger_h {E R} (t : itree E R) :
   interp ITree.trigger t ≈ t.
 Proof.
-  revert t. einit. ecofix CIH. intros.
+  revert t. coinduction. intros.
   rewrite unfold_interp. rewrite (itree_eta t) at 2.
-  destruct (observe t); try estep.
-  unfold ITree.trigger. simpl. rewrite bind_vis.
-  evis. intros. rewrite bind_ret_l, tau_euttge.
-  auto with paco.
+  destruct (observe t); cbn; eauto with itree. 
+  constructor; intro. fold_subst. 
+  rewrite bind_ret_l, tau_euttge.
+  apply CIH. 
 Qed.
 
 (** ** Composition of [interp] *)
@@ -277,46 +263,36 @@ Theorem interp_interp {E F G R} (f : E ~> itree F) (g : F ~> itree G) :
       interp g (interp f t)
     ≅ interp (fun _ e => interp g (f _ e)) t.
 Proof.
-  ginit. pcofix CIH. intros.
+  coinduction. intros. 
   rewrite 2 (unfold_interp t).
-  destruct (observe t); cbn.
-  - rewrite interp_ret. gstep. constructor. reflexivity.
-  - rewrite interp_tau. gstep. constructor. auto with paco.
-  - rewrite interp_bind.
-    guclo eqit_clo_bind.
-    apply pbc_intro_h with (RU := eq).
-    + reflexivity.
-    + intros ? _ [].
-      rewrite interp_tau.
-      gstep; constructor.
-      auto with paco.
+  destruct (observe t); cbn; eauto with itree. 
+  to_mon. rewrite interp_bind. ebind. intros; subst.  
+  rewrite interp_tau. taus. apply CIH.   
 Qed.
 
 Lemma interp_translate {E F G} (f : E ~> F) (g : F ~> itree G) {R} (t : itree E R) :
   interp g (translate f t) ≅ interp (fun _ e => g _ (f _ e)) t.
 Proof.
   revert t.  
-  ginit. pcofix CIH.
+  coinduction. 
   intros t.
   rewrite !unfold_interp. unfold _interp.
   rewrite unfold_translate_. unfold translateF.
   destruct (observe t); cbn.
   - apply reflexivity. (* SAZ: typeclass resolution failure? *)
-  - gstep. constructor. gbase. apply CIH.
-  - guclo eqit_clo_bind; econstructor.
-    + reflexivity.
-    + intros ? _ []. gstep; constructor; auto with paco.
+  - taus. apply CIH. 
+  - to_mon. ebind. intros; subst. taus. apply CIH.  
 Qed.
 
 Lemma translate_to_interp {E F R} (f : E ~> F) (t : itree E R) :
   translate f t ≈ interp (fun _ e => ITree.trigger (f _ e)) t.
 Proof.
-  revert t. einit. ecofix CIH. intros.
+  revert t. coinduction. intros.
   rewrite unfold_translate.
   rewrite unfold_interp.
-  destruct (observe t); try estep.
-  unfold ITree.trigger. simpl. rewrite bind_vis.
-  evis. intros. rewrite bind_ret_l, tau_euttge. auto with paco.
+  destruct (observe t); cbn; eauto with itree. 
+  constructor. intro. fold_subst. 
+  rewrite bind_ret_l, tau_euttge. apply CIH. 
 Qed.
 
 Lemma interp_forever {E F} (f : E ~> itree F) {R S}
@@ -324,13 +300,13 @@ Lemma interp_forever {E F} (f : E ~> itree F) {R S}
   : interp f (ITree.forever t)
   ≅ @ITree.forever F R S (interp f t).
 Proof.
-  ginit. pcofix CIH.
+  coinduction. 
   rewrite (unfold_forever t).
   rewrite (unfold_forever (interp _ _)).
   rewrite interp_bind.
-  guclo eqit_clo_bind. econstructor; [reflexivity |].
-  intros ? _ []. rewrite interp_tau.
-  gstep. constructor; auto with paco.
+  ebind. intros; subst.
+  rewrite interp_tau.
+  taus. apply CIH. 
 Qed.
 
 Lemma interp_iter' {E F} (f : E ~> itree F) {I A}
@@ -341,14 +317,14 @@ Lemma interp_iter' {E F} (f : E ~> itree F) {I A}
     interp f (ITree.iter t i)
   ≅ ITree.iter t' i.
 Proof.
-  ginit. pcofix CIH; intros i.
+  coinduction; intros i. 
   rewrite 2 unfold_iter.
   rewrite interp_bind.
-  guclo eqit_clo_bind; econstructor; eauto.
-  { apply EQ_t. }
-  intros [] _ []; cbn.
-  - rewrite interp_tau; gstep; constructor; auto with paco.
-  - rewrite interp_ret. gstep; constructor; auto.
+  ebind. 
+  { do 2 step. apply EQ_t. }
+  intros [] _ []; cbn; to_mon. 
+  - taus. apply CIH. 
+  - reflexivity. 
 Qed.
 
 Lemma interp_iter {E F} (f : E ~> itree F) {A B}
@@ -366,13 +342,14 @@ Lemma interp_iter'_eutt {E F} (f: E ~> itree F) {I A}
     (Heq: forall i, interp f (t i) ≈ t' i):
   forall i, interp f (ITree.iter t i) ≈ ITree.iter t' i.
 Proof.
-  ginit. gcofix CIH; intros i.
+  coinduction; intros i. 
   rewrite 2 unfold_iter.
   rewrite interp_bind.
-  guclo eqit_clo_bind; econstructor; eauto. apply Heq.
+  ebind. 
+  do 2 step. apply Heq.
   intros [] _ []; cbn.
-  - rewrite interp_tau; gstep; constructor; auto with paco.
-  - rewrite interp_ret. gstep; constructor; auto.
+  - taus. apply CIH. 
+  - reflexivity. 
 Qed.
 
 Lemma interp_loop {E F} (f : E ~> itree F) {A B C}
diff --git a/theories/Interp/RecursionFacts.v b/theories/Interp/RecursionFacts.v
index 7301f36b..22ec9188 100644
--- a/theories/Interp/RecursionFacts.v
+++ b/theories/Interp/RecursionFacts.v
@@ -5,13 +5,13 @@
     [recursive] as handlers.
  *)
 
-Require Import Paco.paco.
-
-From Coq Require Import
+From Stdlib Require Import
      Program.Tactics
      Setoid
      Morphisms.
 
+From Coinduction Require Import all. 
+
 From ITree Require Import
      Basics.Utils
      Basics.Category
@@ -20,8 +20,6 @@ From ITree Require Import
      Core.ITreeDefinition
      Core.KTree
      Eq.Eqit
-     Eq.UpToTaus
-     Eq.Paco2
      Indexed.Sum
      Indexed.Function
      Indexed.Relation
@@ -66,7 +64,7 @@ Proof.
   - destruct e; cbn.
     + rewrite bind_ret_l; reflexivity.
     + rewrite bind_vis.
-      pstep; constructor. intros. left.
+      step; constructor. intros.
       rewrite bind_ret_l.
       apply reflexivity.
 Qed.
@@ -83,30 +81,36 @@ Definition mrecursive (f : D ~> itree (D +' E))
 Global Instance eq_itree_mrec {R} :
   Proper (eq_itree eq ==> eq_itree eq) (@interp_mrec _ _ ctx R).
 Proof.
-  ginit. pcofix CIH. intros.
+  repeat red. 
+  coinduction. intros.
   rewrite !unfold_interp_mrec.
-  punfold H0. inv H0; try discriminate; pclearbot; simpobs; [| |destruct e]; gstep.
-  - apply reflexivity.
-  - econstructor. eauto with paco.
-  - econstructor. gbase. eapply CIH. apply eqit_bind; auto; reflexivity.
-  - econstructor. gstep; constructor. auto with paco itree.
+  step in H. inv H; eauto with itree. 
+  - taus. now apply CIH. 
+  - cbn. destruct e.
+    + taus. apply CIH.
+      ebind. intros; subst.  
+    do 2 step. apply REL. 
+    + constructor. intro. step. taus. apply CIH.
+    apply REL.   
 Qed.
 
 Theorem interp_mrec_bind {U T} (t : itree _ U) (k : U -> itree _ T) :
   interp_mrec ctx (ITree.bind t k) ≅
   ITree.bind (interp_mrec ctx t) (fun x => interp_mrec ctx (k x)).
 Proof.
-  revert t k; ginit. pcofix CIH; intros.
+  revert t k; coinduction; intros.
   rewrite (unfold_interp_mrec _ t).
   rewrite (unfold_bind t).
   destruct (observe t); cbn;
-    [| |destruct e];
-    autorewrite with itree.
-  1: apply reflexivity.
-  all: rewrite unfold_interp_mrec; ITree.fold_subst.
-  all: try (gstep; econstructor; eauto with paco).
-  - rewrite <- bind_bind; eauto with paco.
-  - intros. red. rewrite bind_tau. gstep; constructor; auto with paco.
+    [| |destruct e]; cbn. 
+  - apply reflexivity.
+  - taus. fold_subst. apply CIH. 
+  - to_mon. taus. fold_subst. 
+    rewrite <- bind_bind.
+    apply CIH.  
+  - constructor. intro. fold_subst. 
+    rewrite bind_ret_l, bind_tau. 
+    step. taus. apply CIH.   
 Qed.
 
 Theorem interp_mrec_trigger {U} (a : (D +' E) U) :
@@ -117,7 +121,7 @@ Proof.
   destruct a; cbn.
   rewrite tau_euttge, bind_ret_r.
   reflexivity.
-  pstep; constructor. intros; left. rewrite tau_euttge, unfold_interp_mrec; cbn.
+  step; constructor. intros. rewrite tau_euttge, unfold_interp_mrec; cbn.
   apply reflexivity.
 Qed.
 
@@ -125,19 +129,17 @@ Theorem interp_mrec_as_interp {T} (c : itree _ T) :
   interp_mrec ctx c ≈ interp (mrecursive ctx) c.
 Proof.
   rewrite <- (tau_eutt (interp _ _)).
-  revert_until T. ginit. pcofix CIH. intros.
+  revert_until T. coinduction. intros.
   rewrite unfold_interp_mrec, unfold_interp.
-  destruct (observe c); [| |destruct e]; simpl; eauto with paco.
-  - gstep; repeat econstructor; eauto.
-  - gstep; constructor; eauto with paco.
-  - rewrite interp_mrec_bind. unfold mrec.
-    gstep; constructor.
-    guclo eqit_clo_bind; econstructor; [reflexivity|].
-    intros ? _ []; eauto with paco.
-  - rewrite tau_euttge. unfold ITree.trigger, case_; simpl. rewrite bind_vis.
-    gstep. constructor.
-    intros; red.
-    rewrite bind_ret_l. rewrite tau_euttge. auto with paco.
+  destruct (observe c0); [| |destruct e]; simpl; eauto.
+  - now taur. 
+  - taus. apply CIH. 
+  - taus. rewrite interp_mrec_bind. unfold mrec.
+  ebind. intros; subst. apply CIH. 
+  - to_mon. rewrite tau_euttge. 
+    unfold ITree.trigger.  rewrite bind_vis.
+    constructor. intro. 
+    rewrite bind_ret_l. rewrite tau_euttge. apply CIH. 
 Qed.
 
 Theorem mrec_as_interp {T} (d : D T) :
@@ -158,25 +160,25 @@ Theorem unfold_interp_mrec_h {T} (t : itree _ T)
   ≈ interp_mrec ctx t.
 Proof.
   rewrite <- tau_eutt.
-  revert t. ginit; pcofix CIH. intros.
+  revert t. coinduction. intros.
   rewrite (itree_eta t); destruct (observe t).
-  - rewrite 2 unfold_interp_mrec; cbn; gstep; repeat constructor; auto with paco.
-  - rewrite unfold_interp, 2 unfold_interp_mrec; cbn. gstep.
-    constructor; auto with paco.
+  - rewrite 2 unfold_interp_mrec; now taul. 
+  - rewrite unfold_interp, 2 unfold_interp_mrec. 
+    taus. apply CIH. 
   - rewrite interp_vis.
     rewrite (unfold_interp_mrec _ (Vis _ _)).
-    destruct e; cbn.
+    destruct e; cbn; to_mon. 
     + rewrite 2 interp_mrec_bind.
-      gstep; constructor.
-      guclo eqit_clo_bind; econstructor; [reflexivity|].
-      intros ? _ []; rewrite unfold_interp_mrec; cbn; auto with paco.
+      taus. 
+      ebind; intros; subst. 
+      rewrite unfold_interp_mrec; cbn; apply CIH. 
     + unfold inr_, Handler.Inr_sum1_Handler, Handler.Handler.inr_, Handler.Handler.htrigger.
-      rewrite bind_trigger, unfold_interp_mrec; cbn.
+      rewrite bind_trigger, unfold_interp_mrec; cbn; to_mon.
       rewrite tau_euttge.
-      gstep; constructor.
-      intros; red. gstep; constructor.
+      constructor.
+      intros. step. taus. 
       rewrite unfold_interp_mrec; cbn.
-      auto with paco.
+      apply CIH. 
 Qed.
 
 End Facts.
@@ -190,17 +192,16 @@ Global Instance Proper_interp_mrec {D E} :
           interp_mrec.
 Proof.
   intros f g Hfg R.
-  ginit; pcofix CIH; intros t1 t2 Ht.
+  coinduction; intros t1 t2 Ht.
   rewrite 2 unfold_interp_mrec.
-  punfold Ht; induction Ht; cbn; pclearbot.
-  3: { destruct e; gstep; constructor.
-    + gfinal; left. apply CIH.
-      eapply eutt_clo_bind; eauto.
-      intros ? _ []. auto with itree.
-    + gstep; constructor. auto with paco itree.
+  step in Ht; induction Ht; cbn. 
+  3: { destruct e; constructor. 
+    + apply CIH. ebind. apply Hfg.  
+      intros ? _ []. apply REL. 
+    + intros; step; taus. eauto with itree.
   }
-  1,2: gstep; constructor; auto with paco itree.
-  1,2: rewrite unfold_interp_mrec, tau_euttge; auto.
+  1,2: constructor; auto with itree.
+  all: to_mon; rewrite unfold_interp_mrec, tau_euttge; auto.
 Qed.
 
 (** [rec body] is equivalent to [interp (recursive body)],
@@ -235,17 +236,16 @@ Instance euttge_interp_mrec {D E} :
           interp_mrec.
 Proof.
   intros f g Hfg R.
-  ginit; pcofix CIH; intros t1 t2 Ht.
+  coinduction; intros t1 t2 Ht.
   rewrite 2 unfold_interp_mrec.
-  punfold Ht; induction Ht; cbn; pclearbot.
-  3: { destruct e; gstep; constructor.
-    + gfinal; left. apply CIH.
-      eapply eqit_bind; auto. apply Hfg.
-    + gstep; constructor. auto with paco itree.
+  step in Ht; induction Ht; try easy; cbn. 
+  3: { destruct e; constructor. 
+    + apply CIH. ebind. apply Hfg.  
+      intros ? _ []. apply REL. 
+    + intros; step; taus. eauto with itree.
   }
-  1,2: gstep; constructor; auto with paco.
-  1: rewrite unfold_interp_mrec, tau_euttge; auto.
-  discriminate.
+  1,2: constructor; auto with itree.
+  all: to_mon; rewrite unfold_interp_mrec, tau_euttge; auto.
 Qed.
 
 #[global]
diff --git a/theories/Interp/Traces.v b/theories/Interp/Traces.v
index 41d832b3..97012d53 100644
--- a/theories/Interp/Traces.v
+++ b/theories/Interp/Traces.v
@@ -1,18 +1,15 @@
 (** * ITrees as sets of traces *)
 
 (* begin hide *)
-From Paco Require Import
-     paco.
+From Coinduction Require Import all.
 
 From ITree Require Import
      Basics.Utils
      Axioms
      Core.ITreeDefinition
      Eq.Eqit
-     Eq.UpToTaus
      Eq.SimUpToTaus
-     Eq.Shallow
-     Eq.Paco2.
+     Eq.Shallow.
 
 Local Open Scope itree.
 (* end hide *)
@@ -85,24 +82,24 @@ Proof.
   red. intros. red in H0. remember (observe t1).
   generalize dependent t1. generalize dependent t2.
   induction H0; intros; try solve [constructor].
-  - punfold H. rewrite <- Heqi in H.
+  - step in H. rewrite <- Heqi in H.
     remember (RetF _). remember (observe t2).
     generalize dependent t2.
     induction H; intros; try inv Heqi0; red; rewrite <- Heqi1; constructor.
     eapply IHsuttF; eauto.
   - apply IHis_traceF with (t1:=t); auto.
     apply sutt_inv_tau_left. red. red in H. rewrite <- Heqi in H. auto.
-  - punfold H. rewrite <- Heqi in H.
+  - step in H. rewrite <- Heqi in H.
     remember (VisF _ _). remember (observe t2).
     generalize dependent t2.
     induction H; intros; try discriminate.
     + inv_Vis. subst. red. rewrite <- Heqi1. constructor.
     + red. rewrite <- Heqi1. constructor. eapply IHsuttF; eauto.
-  - punfold H. rewrite <- Heqi in H.
+  - step in H. rewrite <- Heqi in H.
     remember (VisF _ _). remember (observe t2).
     generalize dependent t2.
     induction H; intros; try discriminate.
-    + inv_Vis. pclearbot. subst. red. rewrite <- Heqi1. constructor.
+    + inv_Vis. subst. red. rewrite <- Heqi1. constructor.
       eapply IHis_traceF; auto with itree.
     + red. rewrite <- Heqi1. constructor. apply IHsuttF; auto.
 Qed.
@@ -133,10 +130,10 @@ Qed.
 Lemma trace_incl_sutt : forall {E R} (t1 t2 : itree E R),
     trace_incl t1 t2 -> sutt eq t1 t2.
 Proof.
-  intros E R. pcofix CIH. pstep. intros t1 t2 Hincl.
+  intros E R. coinduction c CIH. intros t1 t2 Hincl.
   unfold trace_incl in *. unfold is_trace in *.
   destruct (observe t1).
-  - assert (H : is_traceF (RetF r0 : itreeF E R (itree E R)) (TRet r0)) by constructor.
+  - assert (H : is_traceF (RetF r : itreeF E R (itree E R)) (TRet r)) by constructor.
     apply Hincl in H. clear Hincl. destruct (observe t2); inv H.
     + constructor. auto.
     + constructor.
@@ -144,7 +141,7 @@ Proof.
       generalize dependent t.
       induction H1; intros; try inv Heqt0; auto with itree.
       constructor. eapply IHis_traceF; eauto.
-  - constructor. right. apply CIH. intros. apply Hincl. constructor. auto.
+  - constructor. apply CIH. intros. apply Hincl. constructor. auto.
   - assert (H: is_traceF (VisF e k) (TEventEnd e)) by constructor.
     apply Hincl in H. destruct (observe t2); inv H.
     + constructor.
@@ -159,10 +156,10 @@ Proof.
       * constructor. eapply IHis_traceF; eauto.
         intros. rewrite is_traceF_tau. apply Hincl; auto.
       * apply eq_trace_inv in Heqt0; destruct Heqt0 as [<- <-].
-        subst. constructor. intro. right. apply CIH. intros.
+        subst. constructor. intro. apply CIH. intros.
         assert (is_traceF (VisF e k) (TEventResponse e x tr)) by (constructor; auto).
         apply Hincl in H1. inv H1. ddestruction. auto.
-    + ddestruction. constructor. intro. right. apply CIH. intros.
+    + ddestruction. constructor. intro. apply CIH. intros.
       assert (is_traceF (VisF e0 k) (TEventResponse e0 x tr)) by (constructor; auto).
       apply Hincl in H0. inv H0. ddestruction; auto.
 Qed.
@@ -181,9 +178,10 @@ Proof.
   intros E R t1 t2 [? ?]. apply sutt_eutt.
   - apply trace_incl_sutt; auto.
   - apply trace_incl_sutt in H0. clear H.
-    generalize dependent t1. generalize dependent t2. pcofix CIH; pstep; intros.
-    punfold H0. induction H0; constructor; try red; pclearbot; eauto with paco itree.
-    right. rewrite itree_eta'. eauto with paco itree.
+    generalize dependent t1. generalize dependent t2.
+    coinduction c CIH. intros t1 t2 H0. step in H0.
+    induction H0; constructor; eauto with itree.
+    apply (CIH t0 (go ot2)). apply EQTAUS.
 Qed.
 
 Theorem trace_eq_iff_eutt : forall {E R} (t1 t2 : itree E R),
diff --git a/theories/Interp/TranslateFacts.v b/theories/Interp/TranslateFacts.v
index e4b62715..52a7a958 100644
--- a/theories/Interp/TranslateFacts.v
+++ b/theories/Interp/TranslateFacts.v
@@ -1,13 +1,13 @@
 (** * Theorems about [Interp.translate] *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Program
      Setoid
      Morphisms
      RelationClasses.
 
-From Paco Require Import paco.
+From Coinduction Require Import all. 
 
 From ITree Require Import
      Basics.Basics
@@ -16,8 +16,6 @@ From ITree Require Import
      Core.Subevent
      Eq.Shallow
      Eq.Eqit
-     Eq.UpToTaus
-     Eq.Paco2
      Indexed.Sum
      Indexed.Function
      Indexed.Relation
@@ -50,32 +48,31 @@ Qed.
 Lemma translate_ret : forall (r:R), translate h (Ret r) ≅ Ret r.
 Proof.
   intros r.
-  rewrite itree_eta, unfold_translate. cbn. reflexivity.
+  rewrite unfold_translate. cbn. reflexivity.
 Qed.
 
 Lemma translate_tau : forall (t : itree E R), translate h (Tau t) ≅ Tau (translate h t).
 Proof.
   intros t.
-  rewrite itree_eta, unfold_translate. cbn. reflexivity.
+  rewrite unfold_translate. cbn. reflexivity.
 Qed.
 
 Lemma translate_vis : forall X (e:E X) (k : X -> itree E R),
     translate h (Vis e k) ≅ Vis (h _ e) (fun x => translate h (k x)).
 Proof.
   intros X e k.
-  rewrite itree_eta, unfold_translate. cbn. reflexivity.
+  rewrite unfold_translate. cbn. reflexivity.
 Qed.
 
 #[global]
 Instance eq_itree_translate' :
   Proper (eq_itree eq ==> eq_itree eq) (@translate _ _ h R).
 Proof.
-  ginit. pcofix CIH.
-  intros x y H.
-  rewrite itree_eta, (itree_eta (translate h y)), !unfold_translate, <-!itree_eta.
-  punfold H. gstep. red in H |- *.
-  destruct (observe x); dependent destruction H; try discriminate;
-    pclearbot; simpobs; simpl; eauto 7 with paco itree.
+  intros!. revert x y H. icoinduction c CIH. intros. 
+  to_mon. 
+  rewrite !unfold_translate.
+  step in H.
+  induction H; simpobs; simpl; eauto with itree.  
 Qed.
 
 #[global]
@@ -95,32 +92,27 @@ Lemma translate_bind : forall {E F R S} (h : E ~> F) (t : itree E S) (k : S -> i
 Proof.
   intros E F R S h t k.
   revert S t k.
-  ginit. pcofix CIH.
-  intros s t k.
+  icoinduction c CIH. 
+  intros s t k. to_mon. 
   match goal with
   | [ |- _ ?t1 ?t2 ] => rewrite (itree_eta_ t1), (itree_eta_ t2)
   end; cbn.
   unfold observe; cbn.
-  destruct (observe t); cbn.
-  - apply reflexivity.
-  - gstep. constructor. eauto with paco.
-  - gstep. constructor. eauto with paco itree.
+  destruct (observe t); cbn; eauto with itree. 
 Qed.
 
 Lemma translate_id : forall E R (t : itree E R), translate (id_ _) t ≅ t.
 Proof.
   intros E R t.
   revert t.
-  ginit. pcofix CIH.
-  intros t.
-  rewrite itree_eta.
+  coinduction c CIH. intros. 
+  (* TOUR: order: need `rewrite itree_eta.` last, or we 
+  will be doing rewrites under {| _observe := observe _ |}, which is very slow. *)
   rewrite (itree_eta t).
   rewrite unfold_translate.
   unfold translateF.
-  destruct (observe t); cbn.
-  - apply reflexivity.
-  - gstep. econstructor. gbase. apply CIH.
-  - gstep. econstructor. intros. gbase. apply CIH.
+  rewrite itree_eta.
+  destruct (observe t); cbn; try constructor; eauto.  
 Qed.
 
 Import CatNotations.
@@ -130,17 +122,11 @@ Lemma translate_cmpE : forall E F G R (g : F ~> G) (f : E ~> F) (t : itree E R),
 Proof.
   intros E F G R g f t.
   revert t.
-  ginit. pcofix CIH.
-  intros t.
+  coinduction c CIH. intros. 
   rewrite !unfold_translate.
-  genobs_clear t ot. destruct ot; cbn.
-  - apply reflexivity.
-  - gstep. econstructor. gbase. apply CIH.
-  - gstep. econstructor. intros. gbase. apply CIH.
+  genobs_clear t ot. destruct ot; cbn; try constructor; eauto. 
 Qed.
 
-(**)
-
 Definition respectful_eq_itree {E F : Type -> Type}
   : (itree E ~> itree F) -> (itree E ~> itree F) -> Prop
   := i_respectful (fun _ => eq_itree eq) (fun _ => eq_itree eq).
@@ -174,13 +160,10 @@ Instance eq_itree_translate {E F}
             translate.
 Proof.
   intros f g Hfg T.
-  ginit. pcofix CIH; rename r into rr; intros l r Hlr.
+  coinduction c CIH. intros. 
   rewrite 2 unfold_translate.
-  punfold Hlr; red in Hlr.
-  destruct Hlr; cbn; try discriminate; pclearbot.
-  - gstep. constructor; auto.
-  - gstep. constructor; auto with paco.
-  - rewrite Hfg. gstep. constructor; red; auto with paco itree.
+  step in H. 
+  destruct H; cbn; try easy; try rewrite Hfg; eauto with itree. 
 Qed.
 
 #[global]
@@ -191,14 +174,10 @@ Instance eutt_translate {E F}
 Proof.
   repeat red.
   intros until T.
-  ginit. pcofix CIH. intros.
-  rewrite !unfold_translate. punfold H1. red in H1.
-  induction H1; intros; subst; simpl.
-  - gstep. econstructor. eauto.
-  - gstep. econstructor. pclearbot. eauto with paco.
-  - gstep. rewrite H. econstructor. pclearbot. red. eauto 7 with paco itree.
-  - rewrite tau_euttge, unfold_translate. eauto.
-  - rewrite tau_euttge, unfold_translate. eauto.
+  coinduction c CIH. intros.
+  rewrite !unfold_translate. step in H0. 
+  induction H0; subst; simpl; eauto with itree. 
+  - rewrite H. econstructor. eauto with itree.
 Qed.
 
 #[global]
@@ -218,16 +197,9 @@ Lemma eutt_translate_gen :
 Proof.
   intros *.
   revert t s.
-  einit.
-  ecofix CIH.
-  intros * EUTT.
-  rewrite !unfold_translate. punfold EUTT. red in EUTT.
-  induction EUTT; intros; subst; simpl; pclearbot.
-  - estep.
-  - estep. 
-  - estep; intros ?; ebase.
-  - rewrite tau_euttge, unfold_translate. eauto with itree.
-  - rewrite tau_euttge, unfold_translate. eauto with itree.
+  coinduction c CIH. intros. 
+  rewrite !unfold_translate. step in H. 
+  induction H; intros; subst; simpl; eauto with itree. 
 Qed. 
 
 Lemma translate_trigger {E F G} `{E -< F} :
@@ -245,10 +217,9 @@ Lemma translate_Vis_inv {E F} {R T} (h: E ~> F) (t: itree E R) (e': F T) k':
 Proof.
   intros. rewrite (itree_eta t) in H. setoid_rewrite (itree_eta t).
   desobs t Ht; clear t Ht; rewrite unfold_translate in H; cbn in H.
-  - punfold H; red in H; inversion H.
-  - punfold H; red in H; inversion H; inversion CHECK.
-  - apply eqitree_inv_Vis_r in H. destruct H as [k'' [H1 H2]].
-    cbn in H1. dependent destruction H1.
-    exists e, k. split. reflexivity. split. reflexivity.
-    intro x. symmetry. eauto.
+  - step in H; easy. 
+  - sinv H; easy.  
+  - apply eqitree_inv_Vis_r in H; break H. 
+    cbn in H. inv_Vis. 
+    exists e, k. repeat now split. 
 Qed.
diff --git a/theories/Props/Cofinite.v b/theories/Props/Cofinite.v
index 6f24ff66..b8ba3ca2 100644
--- a/theories/Props/Cofinite.v
+++ b/theories/Props/Cofinite.v
@@ -6,21 +6,25 @@ From ITree Require Import
   Props.Finite
   Props.Infinite.
 
-From Paco Require Import paco.
+From Coinduction Require Import all.
 
 Theorem not_all_infinite_any_finite {E A} (t : itree E A)
   : all_infinite t -> any_finite t -> False.
 Proof.
-  intros H1 H2. induction H2; punfold H1; inversion H1; try congruence.
-  all: pclearbot; rewrite H in H0; inversion H0; subst; auto.
+  intros H1 H2. induction H2; apply (gfp_fp all_infinite_mon) in H1;
+    cbn[all_infinite_mon body] in H1; unfold all_infinite_ in H1;
+    inversion H1; try congruence.
+  all: rewrite H in H0; inversion H0; subst; auto.
   ddestruction. exact (IHany_finite (H3 _)).
 Qed.
 
 Theorem not_any_infinite_all_finite {E A} (t : itree E A)
   : any_infinite t -> all_finite t -> False.
 Proof.
-  intros H1 H2; induction H2; punfold H1; inversion H1; try congruence.
-  - pclearbot. rewrite H in H0; inversion H0; subst; auto.
-  - pclearbot. rewrite H in H3. inversion H3; subst; ddestruction.
+  intros H1 H2; induction H2; apply (gfp_fp any_infinite_mon) in H1;
+    cbn[any_infinite_mon body] in H1; unfold any_infinite_ in H1;
+    inversion H1; try congruence.
+  - rewrite H in H0; inversion H0; subst; auto.
+  - rewrite H in H3. inversion H3; subst; ddestruction.
     exact (H2 _ H4).
 Qed.
diff --git a/theories/Props/EuttNoRet.v b/theories/Props/EuttNoRet.v
index ccc11e42..1e7847fd 100644
--- a/theories/Props/EuttNoRet.v
+++ b/theories/Props/EuttNoRet.v
@@ -1,4 +1,6 @@
-From Coq Require Import
+From Coinduction Require Import all.
+
+From Stdlib Require Import
      Morphisms
 .
 
@@ -6,10 +8,10 @@ From ITree Require Import
      Axioms
      ITree
      ITreeFacts
+     Eq.Shallow
      Props.Infinite
 .
 
-From Paco Require Import paco.
 
 Import Monads.
 Import MonadNotation.
@@ -27,20 +29,23 @@ Definition euttNoRet {E} {A B : Type} (ta : itree E A) (tb : itree E B) :=
 
 Lemma euttNoRet_spin : forall (E : Type -> Type) (A B : Type), @euttNoRet E A B ITree.spin ITree.spin.
 Proof.
-  intros. pcofix CIH. pfold. red. cbn. constructor. right.
-  eauto.
+  intros. unfold euttNoRet. icoinduction c CIH. cbn. constructor. exact CIH.
 Qed.
 
 Lemma noret_bind_nop : forall (E : Type -> Type) (A B : Type) (t : itree E A) (f : A -> itree E B),
     all_infinite t -> euttNoRet t (t >>= f).
 Proof.
-  intros. einit. generalize dependent t. ecofix CIH. intros t Hdivt. pinversion Hdivt.
-  - specialize (itree_eta t) as Ht. rewrite <- H in Ht.
-    cbn. rewrite Ht.
-    assert (ITree.bind (Tau t0) f ≅ Tau (ITree.bind t0 f)); try apply bind_tau.
-    setoid_rewrite H1. etau.
-  - specialize (itree_eta t) as Ht. rewrite <- H in Ht.
-    cbn. rewrite Ht. rewrite bind_vis. evis.
+  intros E A B. unfold euttNoRet. icoinduction c CIH. intros t f Hdiv.
+  apply (gfp_fp all_infinite_mon) in Hdiv.
+  cbn[all_infinite_mon body] in Hdiv. unfold all_infinite_ in Hdiv.
+  inversion Hdiv; subst.
+  - unfold bind, Monad_itree.
+    rewrite observe_bind. rewrite <- H. cbn. apply EqTau.
+    apply CIH. auto.
+  - unfold bind, Monad_itree.
+    rewrite observe_bind. rewrite <- H. cbn. apply EqVis.
+    intros v. 
+    apply CIH. apply H0.
 Qed.   
 
 Lemma euttNoRet_subrel : forall (E : Type -> Type) (A B : Type) (R : A -> B -> Prop) 
@@ -48,66 +53,60 @@ Lemma euttNoRet_subrel : forall (E : Type -> Type) (A B : Type) (R : A -> B -> P
     euttNoRet ta tb -> eutt R ta tb.
 Proof.
   intros.
-  eapply eutt_subrel with (R1 := fun a b => False); tauto.
+  eapply eqit_mono with (b1 := true) (b2 := true) (RR := fun _ _ => False);
+    try (repeat intro; contradiction); auto.
 Qed.
 
 Lemma all_infinite_euttNoRet : forall (E : Type -> Type) (A B : Type) (R : A -> B -> Prop) 
                             (ta : itree E A) (tb : itree E B),
     all_infinite ta -> eutt R ta tb -> euttNoRet ta tb.
 Proof.
-  (* oddly had trouble doing this with euttG, maybe I should reread the gpaco paper*)
-  intros E A B R. pcofix CIH. pstep. intros ta tb Hdiv Heutt.
-  punfold Heutt. unfold_eqit. dependent induction Heutt; pclearbot.
-  - exfalso. clear CIH. specialize (itree_eta ta) as Hta.
-    rewrite <- x0 in Hta. rewrite Hta in Hdiv. pinversion Hdiv.
-  - rewrite <- x0. rewrite <- x. constructor. right.
-    assert (m1 ≈ ta).
-    { specialize (itree_eta ta) as Hta. rewrite <- x0 in Hta.
-      rewrite Hta. rewrite tau_eutt. reflexivity. }
-    assert (m2 ≈ tb).
-    { specialize (itree_eta tb) as Htb. rewrite <- x in Htb.
-      rewrite Htb. rewrite tau_eutt. reflexivity. }
-    apply CIH; auto.
-    rewrite H. auto.
-  - rewrite <- x0. rewrite <- x. constructor.
-    intros. right. apply CIH; auto with itree.
-    specialize (itree_eta ta) as Hta. rewrite <- x0 in Hta.
-    rewrite Hta in Hdiv. pinversion Hdiv.
-    dependent destruction H2. apply H0.
-  - rewrite <- x. constructor; auto. eapply IHHeutt; eauto.
-    assert (t1 ≈ ta).
-    { specialize (itree_eta ta) as Hta. rewrite <- x in Hta.
-      rewrite Hta. rewrite tau_eutt. reflexivity. }
-    rewrite H. auto.
-  - rewrite <- x. constructor; auto.
+  intros E A B R. unfold euttNoRet. icoinduction c CIH. intros ta tb Hdiv Heutt.
+  step in Heutt. cbn[eqit_mon body] in Heutt. unfold eqit_ in Heutt.
+  cbn[eqit_mon body]. unfold eqit_.
+  apply (gfp_fp all_infinite_mon) in Hdiv.
+  cbn[all_infinite_mon body] in Hdiv. unfold all_infinite_ in Hdiv.
+  dependent induction Heutt.
+  - exfalso. rewrite <- x0 in Hdiv. inversion Hdiv.
+  - rewrite <- x0. rewrite <- x. apply EqTau. apply CIH.
+    + rewrite <- x0 in Hdiv. inversion Hdiv; subst. auto.
+    + auto.
+  - rewrite <- x0. rewrite <- x. apply EqVis. intros v. apply CIH.
+    + rewrite <- x0 in Hdiv. inversion Hdiv; subst. ddestruction. apply H0.
+    + apply REL.
+  - rewrite <- x. apply EqTauL; auto. apply IHHeutt; auto.
+    rewrite <- x in Hdiv. inversion Hdiv; subst.
+    apply (gfp_fp all_infinite_mon) in H0.
+    cbn[all_infinite_mon body] in H0. unfold all_infinite_ in H0. exact H0.
+  - rewrite <- x. apply EqTauR; auto.
 Qed.
      
 Lemma euttNoRet_all_infinite : forall (E : Type -> Type) (A B : Type) (t1 : itree E A) (t2 : itree E B),
     euttNoRet t1 t2 -> all_infinite t1.
 Proof.
-  intros A B. pcofix CIH. intros. pfold. red.
-  punfold H0.
-  unfold_eqit.
-  dependent induction H0; try contradiction; pclearbot.
-  - rewrite <- x0. constructor. right. eapply CIH; eauto.
-  - rewrite <- x0. constructor. intros. right. eapply CIH; eauto. eapply REL.
-  - rewrite <- x. constructor. right. eapply CIH with (t2 := t2); eauto. 
-    pfold. auto.
-  -  eapply IHeqitF; eauto.
+  intros E A B. unfold all_infinite. coinduction c CIH. intros t1 t2 H.
+  cbn[all_infinite_mon body]. unfold all_infinite_.
+  unfold euttNoRet in H. step in H. cbn[eqit_mon body] in H. unfold eqit_ in H.
+  dependent induction H; try contradiction.
+  - rewrite <- x0. constructor. apply CIH with (t2 := m2). unfold euttNoRet. auto.
+  - rewrite <- x0. constructor. intros v. apply CIH with (t2 := k2 v).
+    unfold euttNoRet. apply REL.
+  - rewrite <- x. constructor. apply CIH with (t2 := t2). unfold euttNoRet.
+    step. cbn[eqit_mon body]. unfold eqit_. auto.
+  - eapply IHeqitF; eauto.
 Qed.
 
 
 Lemma euttNoRet_sym : forall (E : Type -> Type) (A B : Type) (t1 : itree E A) (t2 : itree E B),
     euttNoRet t1 t2 -> euttNoRet t2 t1.
 Proof.
-  intros E A B. pcofix CIH. intros. pfold. red.
-  punfold H0. unfold_eqit.
-  dependent induction H0; try contradiction; pclearbot.
-  - rewrite <- x0. rewrite <- x. constructor. right. auto.
-  - rewrite <- x0. rewrite <- x. constructor. intros. unfold id.
-    right. apply CIH. apply REL.
-  - rewrite <- x. constructor; auto.
-  - rewrite <- x. constructor; auto.
+  intros E A B. unfold euttNoRet. icoinduction c CIH. intros t1 t2 H.
+  unfold euttNoRet in H. step in H. cbn[eqit_mon body] in H. unfold eqit_ in H.
+  dependent induction H; try contradiction.
+  - rewrite <- x0. rewrite <- x. apply EqTau. apply CIH. auto.
+  - rewrite <- x0. rewrite <- x. apply EqVis. intros v. apply CIH. apply REL.
+  - rewrite <- x. apply EqTauR; auto.
+  - rewrite <- x. apply EqTauL; auto.
 Qed.
 
 Lemma all_infinite_bind : forall (E : Type -> Type) (R U: Type) (t : itree E R) 
@@ -123,8 +122,9 @@ Lemma euttNoRet_trans : forall (E : Type -> Type) (A B C : Type) (t1 : itree E A
     euttNoRet t1 t2 -> euttNoRet t2 t3 -> euttNoRet t1 t3.
 Proof.
   intros. unfold euttNoRet in *.
-  apply eutt_subrel with (R1 := @rcompose A B C (fun a b => False) (fun b c => False) ).
-  - intros. inversion H1; contradiction.
+  eapply eqit_mono with (b1 := true) (b2 := true)
+    (RR := rcompose (fun (_:A)(_:B) => False) (fun (_:B)(_:C) => False)); auto.
+  - intros x y Hc. inversion Hc; contradiction.
   - eapply eqit_trans; eauto.
 Qed.
 
diff --git a/theories/Props/Finite.v b/theories/Props/Finite.v
index d803c230..4feb0777 100644
--- a/theories/Props/Finite.v
+++ b/theories/Props/Finite.v
@@ -9,8 +9,7 @@ From ITree Require Import
      Leaf.
 From ITree.Events Require Import Nondeterminism Exception. (* For counterexamples *)
 
-From Paco Require Import paco.
-From Coq Require Import Morphisms Basics Program.Equality.
+From Stdlib Require Import Morphisms Basics Program.Equality.
 Import ITree.
 Import ITreeNotations.
 Import LeafNotations.
@@ -184,16 +183,15 @@ Proof.
   intros * EQ FIN;
   revert u EQ.
   induction FIN; intros u2 EQ.
-  - punfold EQ.
-    red in EQ; rewrite H in EQ; clear H.
+  - step in EQ. 
+    rewrite H in EQ; clear H.
     remember (RetF a); genobs u2 ou.
-    hinduction EQ before R; intros; try discriminate; eauto with itree.
-  - punfold EQ; red in EQ; rewrite H in EQ; clear H.
-    remember (TauF u); genobs u2 ou2.
-    hinduction EQ before R; intros; try discriminate; pclearbot; inv Heqi; eauto with itree.
-  - punfold EQ; red in EQ; rewrite H in EQ; clear H.
+    hinduction EQ before R; intros; try easy; eauto with itree.
+  - step in EQ; rewrite H in EQ; clear H.
+    apply IHFIN. rewrite <- tau_euttge. now step. 
+  - step in EQ; rewrite H in EQ; clear H.
     remember (VisF e k); genobs u2 ou2.
-    hinduction EQ before R; intros; try discriminate; pclearbot.
+    hinduction EQ before R; intros; try easy.
     + revert H0 H1.
       refine (match Heqi in _ = u return match u with VisF e0 k0 => _ | _ => False end with eq_refl => _ end).
       eauto with itree.
@@ -227,16 +225,14 @@ Proof.
   intros * EQ FIN;
   revert u EQ.
   induction FIN; intros u2 EQ.
-  - punfold EQ.
-    red in EQ; rewrite H in EQ; clear H.
+  - step in EQ. rewrite H in EQ; clear H.
     remember (RetF a); genobs u2 ou.
-    hinduction EQ before R; intros; try discriminate; eauto with itree.
-  - punfold EQ; red in EQ; rewrite H in EQ; clear H.
-    remember (TauF u); genobs u2 ou2.
-    hinduction EQ before R; intros; try discriminate; pclearbot; inv Heqi; eauto with itree.
-  - punfold EQ; red in EQ; rewrite H in EQ; clear H.
+    hinduction EQ before R; intros; try easy; eauto with itree.
+  - step in EQ; rewrite H in EQ; clear H.
+      apply IHFIN. rewrite <- tau_euttge. now step. 
+  - step in EQ; rewrite H in EQ; clear H.
     remember (VisF e k); genobs u2 ou2.
-    hinduction EQ before R; intros; try discriminate; pclearbot.
+    hinduction EQ before R; intros; try easy.
     + revert x FIN IHFIN.
       refine (match Heqi in _ = u return match u with VisF e0 k0 => _ | _ => False end with eq_refl => _ end).
       eauto with itree.
@@ -368,17 +364,17 @@ Proof.
   revert t k Hequ.
   induction FIN; intros t' k' ->; rename t' into t.
   - unfold observe in H; cbn in H.
-    desobs t EQ; cbn in *; try congruence.
+    desobs t teq; cbn in *; try congruence.
     split; eauto with itree.
   - unfold observe in H; cbn in H.
-    desobs t EQ; cbn in *; try congruence.
+    desobs t teq; cbn in *; try congruence.
     split; eauto with itree.
     inversion H; clear H; symmetry in H1.
     edestruct IHFIN as (? & ? & ? & ?).
     apply H1.
     split; eauto with itree.
   - unfold observe in H; cbn in H.
-    desobs t EQ; cbn in *; try congruence.
+    desobs t teq; cbn in *; try congruence.
     split; eauto with itree.
     revert x FIN IHFIN.
     refine (match H in _ = u return match u with VisF e0 k0 => _ | _ => False end with eq_refl => _ end).
@@ -499,7 +495,7 @@ Module Counterexamples.
 
 (** * Counterexamples *)
 
-(** Counterexamples to statements that could be expected to be true at firt glance. *)
+(** Counterexamples to statements that could be expected to be true at first glance. *)
 
 (** [all_finite] does _not_ entail [any_finite].
 
diff --git a/theories/Props/HasPost.v b/theories/Props/HasPost.v
index cb42b484..82e5eeb7 100644
--- a/theories/Props/HasPost.v
+++ b/theories/Props/HasPost.v
@@ -1,6 +1,5 @@
 (* begin hide *)
-From Paco Require Import paco.
-From Coq Require Import Morphisms.
+From Stdlib Require Import Morphisms.
 From ITree Require Import
      Basics.Utils
      ITree
@@ -9,6 +8,8 @@ From ITree Require Import
      Interp.TranslateFacts.
 Set Implicit Arguments.
 Set Strict Implicit.
+Import RelNotations.
+#[local] Open Scope relationH_scope.
 (* end hide *)
 
 (** * Unary interpretation for [eutt]: a traditional program logic
@@ -48,10 +49,11 @@ Definition has_post_strong {E X} (t : itree E X) (Q : X -> Prop) : Prop :=
 Lemma has_post_post_strong : forall {E X} (t : itree E X) Q,
     has_post t Q <-> has_post_strong t Q.
 Proof.
-  intros; split; intros HP.
-  - apply eutt_conj; [reflexivity | auto].
-  - eapply eqit_mon; eauto.
-    intros * H; apply H.
+  intros; split; intros HP; red in HP; red.
+  assert (t ≈ t) by auto. 
+  - eapply eutt_conj; [reflexivity | auto].
+  - eapply (eqit_mono (fun x y : X => x = y /\ Q x)); eauto.
+    now intros!. 
 Qed.
 
 Module HasPostNotations.
@@ -65,9 +67,9 @@ Import HasPostNotations.
 Proof.
   repeat red; unfold has_post; intros * EUTT * EQ *; split; intros HP.
   - rewrite <- EUTT; eapply eutt_equiv; eauto.
-    split; red; intros; apply EQ; auto.
+    split; intros ? ? H; apply EQ; auto.
   - rewrite EUTT; eapply eutt_equiv; eauto.
-    split; red; intros; apply EQ; auto.
+    split; intros ? ? H; apply EQ; auto.
 Qed.
 
 #[global] Instance has_post_eutt {E X} :
@@ -75,9 +77,9 @@ Qed.
 Proof.
   repeat red; unfold has_post; intros * EUTT * EQ *; split; intros HP.
   - rewrite <- EUTT; eapply eutt_equiv; eauto.
-    split; red; intros; apply EQ; auto.
+    split; intros ? ? H; apply EQ; auto.
   - rewrite EUTT; eapply eutt_equiv; eauto.
-    split; red; intros; apply EQ; auto.
+    split; intros ? ? H; apply EQ; auto.
 Qed.
 
 (** [has_post] logical primitives.
@@ -89,7 +91,7 @@ Qed.
 Lemma has_post_conj : forall {E X} (t : itree E X) P Q,
     t ⤳ P ->
     t ⤳ Q ->
-    t ⤳ (P /1\ Q).
+    t ⤳ (P ∩ Q).
 Proof.
   intros * HP HQ.
   pose proof eutt_conj _ _ HP HQ.
@@ -99,41 +101,40 @@ Qed.
 (* Left disjunction introduction *)
 Lemma has_post_disj_l : forall {E X} (t : itree E X) P Q,
     t ⤳ P ->
-    t ⤳ (P \1/ Q).
+    t ⤳ (P ∪ Q).
 Proof.
-  intros * HP.
-  epose proof eutt_disj_l _ _ HP as H.
-  apply H.
+  unfold has_post, disj_rel, Disj_unary; intros * HP.
+  eapply eqit_mono. 4: exact HP. 1,2: auto.
+  intros; left; auto.
 Qed.
 
 (* Right disjunction introduction *)
 Lemma has_post_disj_r : forall {E X} (t : itree E X) P Q,
     t ⤳ Q ->
-    t ⤳ (P \1/ Q).
+    t ⤳ (P ∪ Q).
 Proof.
-  intros * HQ.
-  epose proof eutt_disj_r _ _ HQ as H.
-  apply H.
+  unfold has_post, disj_rel, Disj_unary; intros * HQ.
+  eapply eqit_mono. 4: exact HQ. 1,2: auto.
+  intros; right; auto.
 Qed.
 
 (* Weakening *)
 Lemma has_post_weaken : forall {E X} (t : itree E X) P Q,
     t ⤳ P ->
-    P <1= Q ->
+    P ⊑ Q ->
     t ⤳ Q.
 Proof.
-  intros * HP INCL.
-  eapply eqit_mon; eauto.
-  intros; apply INCL; auto.
+  unfold has_post, subrelationH, SubRelH_unary; intros * HP INCL.
+  eapply eqit_mono. 4: exact HP. 1,2: auto.
+  cbn. intros ? ? H; apply INCL; exact H.
 Qed.
 
 (* Trivial postcondition *)
 Lemma has_post_True : forall {E X} (t : itree E X),
     t ⤳ fun _ => True.
 Proof.
-  intros *.
-  eapply eqit_mon; eauto.
-  reflexivity.
+  intros *. red.
+  eapply (eqit_mono eq _ true true); auto. 
 Qed.
 
 (** Structural proof rules *)
@@ -155,7 +156,7 @@ Lemma has_post_bind : forall {E X Y} (t : itree E X) (k : X -> itree E Y) S Q,
     ITree.bind t k ⤳ Q.
 Proof.
   intros * POST1 POST2.
-  apply eutt_clo_bind with (UU := fun x y => x = y /\ S x) ; [apply has_post_post_strong; exact POST1 |].
+  apply eutt_bind_eutt with (UU := fun x y => x = y /\ S x) ; [apply has_post_post_strong; exact POST1 |].
   intros ? ? [<- ?]; eapply POST2; eauto.
 Qed.
 
@@ -171,7 +172,7 @@ Proof.
   intros i ? [<- ?].
   specialize (IND i); apply has_post_post_strong in IND; auto.
   unfold has_post_strong in IND.
-  eapply eqit_mon; try apply IND; auto.
+  eapply eqit_mono; try apply IND; auto.
   intros [] ? [<- ?]; eauto.
 Qed.
 
@@ -187,7 +188,7 @@ Qed.
 (** Enriched relational cut rule
     The main benefit of the approach: post-conditions can be leveraged
     when performing a cut during relational proofs.
-    This lemma generalizes [eutt_clo_bind]
+    This lemma generalizes [eutt_bind_eutt]
  *)
 Lemma eutt_post_bind :
   forall E R1 R2 RR S1 S2 SS Q1 Q2
@@ -199,13 +200,13 @@ Lemma eutt_post_bind :
     eutt RR (ITree.bind t1 k1) (ITree.bind t2 k2).
 Proof.
   intros * POST1 POST2 EQ KEQ.
-  apply eutt_clo_bind with (UU := fun x y => SS x y /\ Q1 x /\ Q2 y).
+  apply eutt_bind_eutt with (UU := fun x y => SS x y /\ Q1 x /\ Q2 y).
   2: intros ? ? (? & ? & ?); apply KEQ; auto.
   clear KEQ.
   apply has_post_post_strong in POST1.
   apply has_post_post_strong in POST2.
-  pose proof eqit_trans _ _ _ _ _ _ _ POST1 EQ as EQ1.
-  pose proof eqit_trans _ _ _ _ _ _ _ EQ1 POST2 as EQ2.
+  pose proof eqit_trans POST1 EQ as EQ1.
+  pose proof eqit_trans EQ1 POST2 as EQ2.
   clear -EQ2.
   eapply eutt_equiv; eauto.
   split.
@@ -221,7 +222,7 @@ Lemma eutt_post_bind_eq : forall E R1 R2 RR U Q (t: itree E U) (k1: U -> itree E
     eutt RR (ITree.bind t k1) (ITree.bind t k2).
 Proof.
   intros * POST ?.
-  apply eutt_clo_bind with (UU := fun x y => x = y /\ Q x); [apply has_post_post_strong; exact POST |].
+  apply eutt_bind_eutt with (UU := fun x y => x = y /\ Q x); [apply has_post_post_strong; exact POST |].
   intros ? ? [-> ?]; auto.
 Qed.
 
@@ -231,19 +232,20 @@ Qed.
 
    This assumes UIP.
  *)
+ (* tour: this proof *)
 Lemma eutt_eq_itree {E X} (R : X -> X -> Prop) : forall (t : itree E X),
   eutt R t t -> eq_itree R t t.
 Proof.
   enough (forall (t u : itree E X), eutt R t u -> eq_itree eq t u -> eq_itree R t u).
   { intros; apply H; [ auto | apply Reflexive_eqit_eq ]. }
-  pcofix CIH.
-  intros t u H EQ. pfold. red.
+  coinduction. 
+  intros t u H EQ. 
   rewrite (itree_eta t), (itree_eta u) in H.
-  punfold EQ. destruct EQ; try discriminate; constructor.
+  step in EQ. cbn. destruct EQ; try discriminate; constructor.
   - rewrite <- eutt_Ret in H. auto.
-  - pclearbot. right; apply CIH; [ | apply REL ].
+  - apply CIH; [ | apply REL ].
     revert H; apply eqit_Tau.
-  - pclearbot. right; apply CIH; [ | apply REL ].
+  - intro. apply CIH; [ | apply REL ].
     eapply eqit_inv_Vis with (1 := H).
 Qed.
 
diff --git a/theories/Props/Infinite.v b/theories/Props/Infinite.v
index babd8a82..65fb9532 100644
--- a/theories/Props/Infinite.v
+++ b/theories/Props/Infinite.v
@@ -4,13 +4,14 @@
     - [any_infinite]: there exists an infinite branch. *)
 
 (* begin hide *)
-From Coq Require Import
+
+From Coinduction Require Import all. 
+
+From Stdlib Require Import
      Setoid
      Morphisms
      RelationClasses.
 
-From Paco Require Import paco.
-
 From ITree Require Import
      Axioms
      Basics
@@ -35,61 +36,58 @@ Definition any_infinite_ {E X} sim :=
   fun t1 => @any_infiniteF E X sim (observe t1).
 #[global] Hint Unfold any_infinite_ : itree.
 
-Lemma any_infiniteF_mono {E X} sim sim' x0
-      (IN: any_infiniteF sim x0)
-      (LE: sim <1= sim'):
-  @any_infiniteF E X sim' x0.
-Proof.
-  intros. induction IN; eauto with itree.
-Qed. 
+Lemma any_infinite__mono {E X} : 
+Proper (leq ==> leq) (@any_infinite_ E X).
+Proof. monauto. Qed. 
 
-Lemma any_infiniteF__mono {E X} :
-  monotone1 (@any_infinite_ E X).
-Proof.
-  do 2 red. intros. eapply any_infiniteF_mono; eauto.
-Qed. 
-#[global] Hint Resolve any_infiniteF__mono : paco.
+Definition any_infinite_mon {E X} : mon (itree E X -> Prop) := 
+   {| body := @any_infinite_ E X ; Hbody := any_infinite__mono |}.
 
-Definition any_infinite {E A} : itree E A -> Prop :=
-  paco1 (@any_infinite_ E A) bot1.
+Definition any_infinite {E X} : itree E X -> Prop :=
+  gfp any_infinite_mon.
 
 #[global]
 Instance any_infinite_proper_eutt {E X R} : Proper (eutt R ==> iff) (@any_infinite E X).
 Proof.
-  repeat intro. split.
-  - revert x y H. pcofix CH. intros.
-    punfold H0. unfold_eqit. pfold. red. punfold H1. red in H1.
-    induction H0.
-    + inversion H1.
-    + apply DivTau. inversion H1; subst. right. eapply CH.
-      red in H0. pclearbot. apply REL.
-      pclearbot. apply H0.
-    + inversion H1; subst. dependent destruction H3. eapply DivVis. 
-      pclearbot. right. eapply CH. apply REL. eapply H0.
-    + apply IHeqitF. inversion H1; subst.
-      pclearbot. punfold H2.
-    + econstructor. left. pfold. red.
-      apply IHeqitF. apply H1.
-  - revert x y H. pcofix CH. intros.
-    punfold H0. unfold_eqit. pfold. red. punfold H1. red in H1.
-    induction H0.
-    + inversion H1.
-    + apply DivTau. inversion H1; subst. right. eapply CH.
-      red in H0. pclearbot. apply REL.
-      pclearbot. apply H0.
-    + inversion H1; subst. dependent destruction H3. eapply DivVis.
-      pclearbot. right. eapply CH. apply REL. eapply H0.
-    + econstructor. left. pfold. red.
-      apply IHeqitF. apply H1.
-    + apply IHeqitF. inversion H1; subst.
-      pclearbot. punfold H2.
+  intros t1 t2 Ht. split; intros Hinf.
+  - revert t2 t1 Ht Hinf. unfold any_infinite at 2. coinduction c CIH.
+    intros t2 t1 Ht Hinf. step in Ht. cbn[eqit_mon body] in Ht. unfold eqit_ in Ht.
+    cbn[any_infinite_mon body]. unfold any_infinite_.
+    apply (gfp_fp any_infinite_mon) in Hinf.
+    cbn[any_infinite_mon body] in Hinf. unfold any_infinite_ in Hinf.
+    induction Ht.
+    + inversion Hinf.
+    + inversion Hinf; subst. constructor. eapply CIH; eauto.
+    + inversion Hinf; subst. dependent destruction H2.
+      econstructor. eapply CIH; [apply REL|]. eauto.
+    + apply IHHt. inversion Hinf; subst.
+      apply (gfp_fp any_infinite_mon) in H0.
+      cbn[any_infinite_mon body] in H0. unfold any_infinite_ in H0. exact H0.
+    + constructor. step. cbn[any_infinite_mon body]. unfold any_infinite_.
+      apply IHHt. exact Hinf.
+  - revert t1 t2 Ht Hinf. unfold any_infinite at 2. coinduction c CIH.
+    intros t1 t2 Ht Hinf. step in Ht. cbn[eqit_mon body] in Ht. unfold eqit_ in Ht.
+    cbn[any_infinite_mon body]. unfold any_infinite_.
+    apply (gfp_fp any_infinite_mon) in Hinf.
+    cbn[any_infinite_mon body] in Hinf. unfold any_infinite_ in Hinf.
+    induction Ht.
+    + inversion Hinf.
+    + inversion Hinf; subst. constructor. eapply CIH; eauto.
+    + inversion Hinf; subst. dependent destruction H2.
+      econstructor. eapply CIH; [apply REL|]. eauto.
+    + constructor. step. cbn[any_infinite_mon body]. unfold any_infinite_.
+      apply IHHt. exact Hinf.
+    + apply IHHt. inversion Hinf; subst.
+      apply (gfp_fp any_infinite_mon) in H0.
+      cbn[any_infinite_mon body] in H0. unfold any_infinite_ in H0. exact H0.
 Qed.
 
 Theorem spin_infinite {E A} : @any_infinite E A ITree.spin.
 Proof.
-  unfold any_infinite, ITree.spin.
-  pcofix H. pfold. constructor. right. apply H.
-Qed. 
+  unfold any_infinite. coinduction c CIH.
+  cbn[any_infinite_mon body]. unfold any_infinite_. cbn.
+  constructor. exact CIH.
+Qed.
 
 Variant all_infiniteF {E : Type -> Type} {A : Type} (F : itree E A -> Prop) : itree' E A -> Prop :=
   | MDivTau (t : itree E A) : F t -> all_infiniteF F (TauF t)
@@ -101,19 +99,18 @@ Definition all_infinite_ {E A} (sim : itree E A -> Prop) t := all_infiniteF sim
 
 Lemma all_infiniteF_mono {E A} (sim sim' : itree E A -> Prop) t
       (IN : all_infiniteF sim t)
-      (LE : sim <1= sim') : all_infiniteF sim' t.
+      (LE : forall x, sim x -> sim' x) : all_infiniteF sim' t.
 Proof.
   induction IN; eauto with itree.
 Qed.
 
-Lemma all_infiniteF_mono' {E A} : monotone1 (@all_infinite_ E A).
-Proof.
-  unfold all_infinite_.
-  red. intros. eapply all_infiniteF_mono; eauto.
-Qed.
-#[global] Hint Resolve all_infiniteF_mono' : paco.
+Lemma all_infinite__mono {E A} : Proper (leq ==> leq) (@all_infinite_ E A).
+Proof. monauto. Qed.
+
+Definition all_infinite_mon {E A} : mon (itree E A -> Prop) :=
+  {| body := @all_infinite_ E A ; Hbody := all_infinite__mono |}.
 
-Definition all_infinite {E A} := paco1 (@all_infinite_ E A) bot1.
+Definition all_infinite {E A} : itree E A -> Prop := gfp (@all_infinite_mon E A).
 
 #[global] Hint Unfold all_infinite : itree.
 
@@ -142,43 +139,50 @@ Ltac contra_void := try match goal with | a : void |- _ => contradiction end.
 #[global]
 Instance eutt_proper_all_infinite {E A R} : Proper (eutt R ==> iff) (@all_infinite E A).
 Proof.
-  intros t1 t2 Ht. split.
-  - revert t1 t2 Ht. pcofix CIH. intros t1 t2 Ht Hdiv.
-    punfold Ht. unfold_eqit. pfold. red. punfold Hdiv. red in Hdiv.
+  intros t1 t2 Ht. split; intros Hinf.
+  - revert t1 t2 Ht Hinf. unfold all_infinite at 2. coinduction c CIH.
+    intros t1 t2 Ht Hinf. step in Ht. cbn[eqit_mon body] in Ht. unfold eqit_ in Ht.
+    cbn[all_infinite_mon body]. unfold all_infinite_.
+    apply (gfp_fp all_infinite_mon) in Hinf.
+    cbn[all_infinite_mon body] in Hinf. unfold all_infinite_ in Hinf.
     induction Ht.
-    + inversion Hdiv.
-    + constructor. inversion Hdiv. subst. right.
-      pclearbot.
-      eapply CIH; eauto.
-    + constructor. inversion Hdiv. subst. ddestruction.
-      subst. intros. right. inversion Hdiv. ddestruction.
-      subst. pclearbot. eapply CIH; auto with itree.
-    + apply IHHt. inversion Hdiv. subst. pclearbot. punfold H0.
-    + constructor. left. pfold. apply IHHt. auto.
-  - revert t1 t2 Ht. pcofix CIH. intros t1 t2 Ht Hdiv.
-    punfold Ht. unfold_eqit. pfold. red. punfold Hdiv. red in Hdiv.
+    + inversion Hinf.
+    + inversion Hinf; subst. constructor. eapply CIH; eauto.
+    + inversion Hinf; subst. dependent destruction H2.
+      econstructor. intros b. eapply CIH; [apply REL|]. apply H0.
+    + apply IHHt. inversion Hinf; subst.
+      apply (gfp_fp all_infinite_mon) in H0.
+      cbn[all_infinite_mon body] in H0. unfold all_infinite_ in H0. exact H0.
+    + constructor. step. cbn[all_infinite_mon body]. unfold all_infinite_.
+      apply IHHt. exact Hinf.
+  - revert t1 t2 Ht Hinf. unfold all_infinite at 2. coinduction c CIH.
+    intros t1 t2 Ht Hinf. step in Ht. cbn[eqit_mon body] in Ht. unfold eqit_ in Ht.
+    cbn[all_infinite_mon body]. unfold all_infinite_.
+    apply (gfp_fp all_infinite_mon) in Hinf.
+    cbn[all_infinite_mon body] in Hinf. unfold all_infinite_ in Hinf.
     induction Ht.
-    + inversion Hdiv.
-    + constructor. inversion Hdiv. subst. right.
-      pclearbot; eauto.
-    + constructor. inversion Hdiv. subst. ddestruction.
-      subst. intros. right. inversion Hdiv. subst. ddestruction.
-      subst. pclearbot. eapply CIH; auto with itree.
-    +  constructor. left. pfold. apply IHHt. auto.
-    +  apply IHHt. inversion Hdiv. subst. pclearbot. punfold H0.
+    + inversion Hinf.
+    + inversion Hinf; subst. constructor. eapply CIH; eauto.
+    + inversion Hinf; subst. dependent destruction H2.
+      econstructor. intros b. eapply CIH; [apply REL|]. apply H0.
+    + constructor. step. cbn[all_infinite_mon body]. unfold all_infinite_.
+      apply IHHt. exact Hinf.
+    + apply IHHt. inversion Hinf; subst.
+      apply (gfp_fp all_infinite_mon) in H0.
+      cbn[all_infinite_mon body] in H0. unfold all_infinite_ in H0. exact H0.
 Qed.
 
 Lemma not_converge_to_all_infinite : forall (E : Type -> Type) (A : Type) (t : itree E A),
     (forall a, ~ may_converge a t) -> all_infinite t.
 Proof.
-  intros E A. pcofix CIH. intros t Hcon. pfold.
-  red. destruct (observe t) eqn : Heq;
-         specialize (itree_eta t) as Ht; rewrite Heq in Ht.
-  - exfalso. apply (Hcon r0). rewrite Ht. constructor. reflexivity.
-  - constructor. right. apply CIH.
-    setoid_rewrite Ht in Hcon. setoid_rewrite tau_eutt in Hcon.
-    auto.
-  - constructor. right. apply CIH.
+  intros E A. unfold all_infinite. coinduction c CIH. intros t Hcon.
+  cbn[all_infinite_mon body]. unfold all_infinite_.
+  destruct (observe t) eqn:Heq;
+    specialize (itree_eta t) as Ht; rewrite Heq in Ht.
+  - exfalso. apply (Hcon r). rewrite Ht. constructor. reflexivity.
+  - constructor. apply CIH.
+    setoid_rewrite Ht in Hcon. setoid_rewrite tau_eutt in Hcon. auto.
+  - constructor. intros b. apply CIH.
     intros a Hcontra. setoid_rewrite Ht in Hcon.
     apply (Hcon a). eapply conv_vis; try reflexivity; eauto.
 Qed.
@@ -195,10 +199,13 @@ Lemma all_infinite_not_converge : forall (E : Type -> Type) (R : Type) (t : itre
     may_converge r t -> ~ all_infinite t.
 Proof.
   intros E R t r Hc Hd. induction Hc.
-  - rewrite H in Hd. pinversion Hd.
-  - apply IHHc. rewrite H in Hd. pinversion Hd.
-    ddestruction. subst.
-    apply H1.
+  - rewrite H in Hd. apply (gfp_fp all_infinite_mon) in Hd.
+    cbn[all_infinite_mon body] in Hd. unfold all_infinite_ in Hd.
+    inversion Hd.
+  - apply IHHc. rewrite H in Hd.
+    apply (gfp_fp all_infinite_mon) in Hd.
+    cbn[all_infinite_mon body] in Hd. unfold all_infinite_ in Hd.
+    inversion Hd. ddestruction. subst. apply H1.
 Qed.
 
 Lemma may_converge_Ret_inv E (A : Type) (a a' : A) : may_converge (E := E) a (Ret a') -> a = a'.
@@ -215,5 +222,8 @@ Ltac inv_infinite_ret := match goal with [ H : any_infiniteF _ (RetF _) |- _  ]
 Lemma no_infinite_ret (E : Type -> Type) (A : Type) (t: itree E A) (a : A)
   : any_infinite t -> t ≈ Ret a -> False.
 Proof.
-  intros H HContra. rewrite HContra in H. pinversion H.
+  intros H HContra. rewrite HContra in H.
+  apply (gfp_fp any_infinite_mon) in H.
+  cbn[any_infinite_mon body] in H. unfold any_infinite_ in H.
+  inversion H.
 Qed.
diff --git a/theories/Props/Leaf.v b/theories/Props/Leaf.v
index aebbb2e3..7593ca5d 100644
--- a/theories/Props/Leaf.v
+++ b/theories/Props/Leaf.v
@@ -1,6 +1,7 @@
 (** * Leaves of an Interaction Tree *)
-
 (* begin hide *)
+From Coinduction Require Import all. 
+
 From ITree Require Import
      Basics.Utils
      Basics.HeterogeneousRelations
@@ -12,8 +13,7 @@ From ITree Require Import
      Events.StateFacts
      Props.HasPost.
 
-From Paco Require Import paco.
-From Coq Require Import Morphisms Basics Program.Equality.
+From Stdlib Require Import Morphisms Basics Program.Equality.
 Import ITree.
 Import ITreeNotations.
 (* end hide *)
@@ -22,7 +22,7 @@ Import ITreeNotations.
 
 (** The [Leaf a t] predicate expresses that [t] has a [Ret] leaf with
     value [a].
-
+  (* TODO REWRITE THIS WITH NEW THEORY *)
     We provide the elementary structural lemmas to work with this
     predicate, and one main useful result relying on [Leaf]: the
     up-to bind closure [eqit_bind_clo] can be refined such that
@@ -112,22 +112,22 @@ Lemma Leaf_eutt_l {E A B R}:
 Proof.
   intros * EQ FIN;
   revert u EQ.
-  induction FIN; intros u2 EQ.
-  - punfold EQ.
-    red in EQ; rewrite H in EQ; clear H t.
+  induction FIN; intros u2 EQ. 
+  - step in EQ. 
+    rewrite H in EQ; clear H t.
     remember (RetF a); genobs u2 ou.
-    hinduction EQ before R; intros; try now discriminate.
+    hinduction EQ before R; intros; try easy.
     + inv Heqi; eauto with itree.
     + edestruct IHEQ as (b & IN & HR); eauto with itree.
-  - punfold EQ; red in EQ; rewrite H in EQ; clear H t.
+  - step in EQ; rewrite H in EQ; clear H t.
     remember (TauF u); genobs u2 ou2.
-    hinduction EQ before R; intros; try discriminate; pclearbot; inv Heqi.
+    hinduction EQ before R; intros; try easy; inv Heqi.
     + edestruct IHFIN as (? & ? & ?); [ .. | eexists ]; eauto with itree.
-    + eauto with itree.
+    + eapply IHFIN. now step. 
     + edestruct IHEQ as (? & ? & ?); [ .. | eexists ]; eauto with itree.
-  - punfold EQ; red in EQ; rewrite H in EQ; clear H t.
+  - step in EQ; rewrite H in EQ; clear H t.
     remember (VisF e k); genobs u2 ou2.
-    hinduction EQ before R; intros; try discriminate; pclearbot.
+    hinduction EQ before R; intros; try discriminate.
     + revert x FIN IHFIN.
       refine (match Heqi in _ = u return match u with VisF e0 k0 => _ | RetF _ | TauF _ => False end with eq_refl => _ end).
       intros. edestruct IHFIN as (? & ? & ?); [ | eexists ]; eauto with itree.
@@ -179,111 +179,78 @@ Proof.
   revert t k Hequ.
   induction FIN; intros t' k' ->; rename t' into t.
   - unfold observe in H; cbn in H.
-    desobs t EQ; cbn in *; try congruence.
+    desobs t EQ_; cbn in *; try congruence.
     exists r; auto with itree.
   - unfold observe in H; cbn in H.
-    desobs t EQ; cbn in *; try congruence; [ eexists; eauto with itree | ].
+    desobs t EQ_; cbn in *; try congruence; [ eexists; eauto with itree | ].
     inversion H; clear H; symmetry in H1.
     edestruct IHFIN as (? & ? & ?); [ eauto | eexists; eauto with itree ].
   - unfold observe in H; cbn in H.
-    desobs t EQ; cbn in *; try congruence; [ eexists; eauto with itree | ].
+    desobs t EQ_; cbn in *; try congruence; [ eexists; eauto with itree | ].
     revert x FIN IHFIN.
     refine (match H in _ = u return match u with VisF e0 k0 => _ | RetF _ | TauF _ => False end with eq_refl => _ end).
     intros.
     edestruct IHFIN as (? & ? & ?); [ reflexivity | eexists; eauto with itree ].
 Qed.
 
-(** Leaf-aware up-to bind closure
-    This construction generalizes [eqit_bind_clo]: one can
-    indeed provide an arbitrary cut at the relational
-    redicate [RU] of one's choice, but the continuations
-    are only required to be related pointwise at the intersection
-    of [RU] with the respective leaves of the prefixes.
+(** Leaf-aware bind rule for [eqit].
+    Generalizes [eqit_bind_chain]: continuations need only be related
+    pointwise at the intersection of [UU] with the respective leaves
+    of the prefixes.
   *)
-Section LeafBind.
-
-  Context {E : Type -> Type} {R S : Type}.
-
-  Local Open Scope itree.
-
-  Inductive eqit_Leaf_bind_clo b1 b2 (r : itree E R -> itree E S -> Prop) :
-    itree E R -> itree E S -> Prop :=
-  | pbc_intro_h U1 U2 (RU : U1 -> U2 -> Prop)
-                (t1 : itree E U1) (t2 : itree E U2)
-                 (k1 : U1 -> itree E R) (k2 : U2 -> itree E S)
-                (EQV: eqit RU b1 b2 t1 t2)
-                (REL: forall u1 u2,
-                      u1 ∈ t1 -> u2 ∈ t2 -> RU u1 u2 ->
-                      r (k1 u1) (k2 u2))
-      : eqit_Leaf_bind_clo b1 b2 r
-            (ITree.bind t1 k1) (ITree.bind t2 k2)
-    .
-  Hint Constructors eqit_Leaf_bind_clo : itree.
-
-  Lemma eqit_Leaf_clo_bind  (RS : R -> S -> Prop) b1 b2 vclo
-        (MON: monotone2 vclo)
-        (CMP: compose (eqitC RS b1 b2) vclo <3= compose vclo (eqitC RS b1 b2))
-        (ID: id <3= vclo):
-    eqit_Leaf_bind_clo b1 b2 <3= gupaco2 (eqit_ RS b1 b2 vclo) (eqitC RS b1 b2).
-  Proof.
-    gcofix CIH. intros. destruct PR.
-    guclo eqit_clo_trans.
-    econstructor; auto_ctrans_eq; try (rewrite (itree_eta (x <- _;; _ x)), unfold_bind; reflexivity).
-    punfold EQV. unfold_eqit.
-    genobs t1 ot1.
-    genobs t2 ot2.
-    hinduction EQV before CIH; intros; pclearbot.
-    - guclo eqit_clo_trans.
-      econstructor; auto_ctrans_eq; try (rewrite <- !itree_eta; reflexivity).
-      gbase; cbn.
-      apply REL0; auto with itree.
-    - gstep. econstructor.
-      gbase.
-      apply CIH.
-      econstructor; eauto with itree.
-    - gstep. econstructor.
-      intros; apply ID; unfold id.
-      gbase.
-      apply CIH.
-      econstructor; eauto with itree.
-    - destruct b1; try discriminate.
-      guclo eqit_clo_trans.
-      econstructor.
-      3:{ eapply IHEQV; eauto with itree. }
-      3,4:auto_ctrans_eq.
-      2: reflexivity.
-      eapply eqit_Tau_l. rewrite unfold_bind, <-itree_eta. reflexivity.
-    - destruct b2; try discriminate.
-      guclo eqit_clo_trans.
-      econstructor; auto_ctrans_eq; eauto with itree; try reflexivity.
-      eapply eqit_Tau_l. rewrite unfold_bind, <-itree_eta. reflexivity.
-  Qed.
-
-End LeafBind.
-
-(** General cut rule for [eqit]
-    This result generalizes [eqit_clo_bind].  *)
 Lemma eqit_clo_bind_gen :
   forall {E} {R1 R2} (RR : R1 -> R2 -> Prop) {U1 U2} {UU : U1 -> U2 -> Prop}
-          b1 b2
+          b1 b2 (c : Chain (eqit_mon b1 b2))
            (t1 : itree E U1) (t2 : itree E U2)
           (k1 : U1 -> itree E R1) (k2 : U2 -> itree E R2),
-    eqit UU b1 b2 t1 t2 ->
+    elem c _ _ UU t1 t2 ->
     (forall (u1 : U1) (u2 : U2),
       u1 ∈ t1 -> u2 ∈ t2 -> UU u1 u2 ->
-      eqit RR b1 b2 (k1 u1) (k2 u2)) ->
-    eqit RR b1 b2 (x <- t1;; k1 x) (x <- t2;; k2 x).
+      elem c _ _ RR (k1 u1) (k2 u2)) ->
+    elem c _ _ RR (ITree.bind t1 k1) (ITree.bind t2 k2).
 Proof.
-    intros.
-    ginit. guclo (@eqit_Leaf_clo_bind E R1 R2).
-    econstructor; eauto.
-    intros * IN1 IN2 HR.
-    gfinal; right.
-    apply H0; auto.
+  intros E R1 R2 RR U1 U2.
+  intros UU b1 b2 c t1 t2 k1 k2.
+  revert UU t1 t2 k1 k2. 
+  tower induction.
+  intros IH.
+  intros UU t1 t2 k1 k2 EQT EQKL.
+  cbn [eqit_mon body] in *.
+  unfold eqit_ in *.
+  genobs t1 ot1.
+  genobs t2 ot2.
+  hinduction EQT before RR; intros.
+  1-3: rewrite 2 observe_bind; simpobs. 
+  + apply EQKL. 
+    * apply LeafRet; auto.
+    * apply LeafRet; auto.
+    * exact REL.
+  + taus. 
+    eapply IH.
+    * exact REL.
+    * intros u1 u2 HL1 HL2 HU.
+      step. apply EQKL.
+      -- eapply LeafTau; eauto.
+      -- eapply LeafTau; eauto.
+      -- exact HU.
+  + constructor. intro v.
+    eapply IH.
+    * apply REL.
+    * intros u1 u2 HL1 HL2 HU.
+      step. apply EQKL.
+      -- eapply LeafVis; eauto.
+      -- eapply LeafVis; eauto.
+      -- exact HU.
+  + rewrite observe_bind. simpobs.
+    taul.
+    eapply IHEQT; eauto with itree.
+  + setoid_rewrite observe_bind at 2. simpobs.
+    taur.
+    eapply IHEQT; eauto with itree.
 Qed.
 
 (** Specialization of the cut rule to [eutt] *)
-Lemma eutt_clo_bind_gen :
+Lemma eutt_bind_eutt_gen :
   forall {E} {R1 R2} (RR : R1 -> R2 -> Prop) {U1 U2} {UU : U1 -> U2 -> Prop}
            (t1 : itree E U1) (t2 : itree E U2)
           (k1 : U1 -> itree E R1) (k2 : U2 -> itree E R2),
@@ -293,7 +260,7 @@ Lemma eutt_clo_bind_gen :
       eutt RR (k1 u1) (k2 u2)) ->
     eutt RR (x <- t1;; k1 x) (x <- t2;; k2 x).
 Proof.
-  intros *; apply eqit_clo_bind_gen.
+  intros *. unfold eutt. apply eqit_clo_bind_gen.
 Qed.
 
 (** Often useful particular case of identical prefixes *)
@@ -302,7 +269,7 @@ Lemma eutt_eq_bind_gen {E R S T} (RS : R -> S -> Prop)
     (forall u, u ∈ t -> eutt RS (k1 u) (k2 u)) ->
     eutt RS (t >>= k1) (t >>= k2).
 Proof.
-  intros; eapply eutt_clo_bind_gen.
+  intros; eapply eutt_bind_eutt_gen.
   reflexivity.
   intros * IN _ <-; eauto.
 Qed.
@@ -332,16 +299,25 @@ Proof.
   intuition; now subst.
 Qed.
 
-Lemma has_post_Leaf_equiv {E R} (t: itree E R) Q:
-  has_post t Q <-> (forall r, r ∈ t -> Q r).
+Lemma has_post_of_Leaf {E R} (Q : R -> Prop) :
+  forall (t : itree E R),
+  (forall r, r ∈ t -> Q r) ->
+  t ≈⟨ fun x _ => Q x ⟩ t.
 Proof.
-  intuition. eapply has_post_Leaf; eauto.
-  revert t H. pcofix CIH; intros t Hpost. pstep; red.
+  icoinduction c CIH. intros t Hpost.
   setoid_rewrite (itree_eta t) in Hpost.
-  desobs t Ht; clear t Ht.
+  desobs t Ht.
   - constructor. apply Hpost, Leaf_Ret.
-  - constructor. right; apply CIH. intros. apply Hpost, Leaf_Tau, H.
-  - constructor. intros. right. apply CIH. intros. eapply Hpost, Leaf_Vis, H.
+  - constructor. apply CIH. intros. apply Hpost. apply Leaf_Tau. exact H.
+  - constructor. intros. apply CIH. intros. eapply Hpost. eapply Leaf_Vis. exact H.
+Qed.
+
+Lemma has_post_Leaf_equiv {E R} (t: itree E R) Q:
+  has_post t Q <-> (forall r, r ∈ t -> Q r).
+Proof.
+  split.
+  - intros; eapply has_post_Leaf; eauto.
+  - intro Hpost. exact (has_post_of_Leaf Q t Hpost).
 Qed.
 
 (** Leaf-based inversion principles for iter *)
@@ -430,7 +406,7 @@ Proof.
   revert t Ht u Hu; induction Hsub; intros.
   - apply SubtreeRefl. now rewrite Ht, Hu.
   - apply SubtreeTau, IHHsub; auto. apply eqit_Tau, Ht.
-  - eapply SubtreeVis. now rewrite Ht, H. apply IHHsub; auto. reflexivity.
+  - eapply SubtreeVis. now rewrite Ht, H. apply IHHsub; auto.
 Qed.
 
 Lemma subtree_image {E R} (t u: itree E R) x:
@@ -445,30 +421,30 @@ Qed.
 Lemma Leaf_interp_subtree_inv {E F R} (h: E ~> itree F) (t u: itree E R):
   subtree u t -> has_post (interp h u) (fun x : R => x ∈ t).
 Proof.
-  revert t u. ginit. gcofix CIH; intros * Hsub.
+  revert t u. unfold has_post. coinduction c CIH; intros * Hsub.
   rewrite (itree_eta u) in Hsub.
-  rewrite ! unfold_interp.
+  rewrite unfold_interp.
   desobs u Hu; clear u Hu; cbn.
-  - gstep; red. constructor. eapply subtree_image; eauto. apply Leaf_Ret.
-  - gstep; red. constructor. gfinal; left. apply CIH. apply SubtreeTau, Hsub.
-  - guclo eqit_clo_bind; econstructor. reflexivity. intros u _ <-.
-    gstep; red. constructor. gfinal; left. apply CIH. eapply SubtreeVis, Hsub.
-    reflexivity.
+  - constructor. eapply subtree_image; eauto. apply Leaf_Ret.
+  - constructor. apply CIH. apply SubtreeTau, Hsub.
+  - to_mon. eapply eqit_bind_chain. reflexivity.
+    intros u _ <-.
+    taus. apply CIH. eapply SubtreeVis, Hsub. reflexivity.
 Qed.
 
 Lemma Leaf_interp_state_subtree_inv {E F S R} (h: E ~> Monads.stateT S (itree F))
   (t u: itree E R) (s: S):
   subtree u t -> has_post (interp_state h u s) (fun x => snd x ∈ t).
 Proof.
-  revert t u s. ginit. gcofix CIH; intros * Hsub.
+  revert t u s. unfold has_post. coinduction c CIH; intros * Hsub.
   rewrite (itree_eta u) in Hsub.
-  rewrite ! unfold_interp_state.
+  rewrite unfold_interp_state.
   desobs u Hu; clear u Hu; cbn.
-  - gstep; red. constructor. eapply subtree_image; eauto. apply Leaf_Ret.
-  - gstep; red. constructor. gfinal; left. apply CIH. apply SubtreeTau, Hsub.
-  - guclo eqit_clo_bind; econstructor. reflexivity. intros [u1 u2] _ <-; cbn.
-    gstep; red. constructor. gfinal; left. apply CIH. eapply SubtreeVis, Hsub.
-    reflexivity.
+  - constructor. eapply subtree_image; eauto. apply Leaf_Ret.
+  - constructor. apply CIH. apply SubtreeTau, Hsub.
+  - to_mon. eapply eqit_bind_chain. reflexivity.
+    intros [u1 u2] _ <-; cbn.
+    taus. apply CIH. eapply SubtreeVis, Hsub. reflexivity.
 Qed.
 
 End Subtree.
diff --git a/theories/Simple.v b/theories/Simple.v
index 254097d1..8b313927 100644
--- a/theories/Simple.v
+++ b/theories/Simple.v
@@ -3,10 +3,12 @@
 (* begin hide *)
 Set Warnings "-notation-overridden".
 
-From Coq Require Import
+From Stdlib Require Import
      Setoid
      Morphisms.
 
+From Coinduction Require Import all. 
+
 From ITree Require Import
      Eq.Shallow.
 (* end hide *)
@@ -269,7 +271,6 @@ End SimpleTheory.
 
 From ITree Require Import
      Eq.Eqit
-     Eq.UpToTaus
      Interp.InterpFacts
      Interp.RecursionFacts.
 
@@ -309,9 +310,8 @@ Proof. intros. subst. reflexivity. Qed.
 
 Lemma eutt_vis {U : Type} (e : E U) (k1 k2 : U -> itree E R)
   : (forall u, k1 u ≈ k2 u) -> Vis e k1 ≈ Vis e k2.
-Proof.
-  intros. ITree.Eq.UpToTaus.einit. ITree.Eq.UpToTaus.evis.
-  intros. ITree.Eq.UpToTaus.efinal. apply H.
+Proof. 
+  intros. apply ITree.Eq.Eqit.eqit_Vis. intros. apply H. 
 Qed.
 
 Lemma eutt_inv_ret (r1 r2 : R)
diff --git a/tutorial/Asm.v b/tutorial/Asm.v
index aa4d69df..623a2207 100644
--- a/tutorial/Asm.v
+++ b/tutorial/Asm.v
@@ -5,7 +5,7 @@
     by jumps.  *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Strings.String
      Program.Basics
      ZArith.ZArith
@@ -349,7 +349,6 @@ Section InterpAsmProperties.
   Proof.
     repeat intro.
     unfold interp_asm.
-    unfold interp_map.
     rewrite H0.
     rewrite H.
     rewrite H1.
@@ -376,11 +375,11 @@ Section InterpAsmProperties.
   Proof.
     intros.
     unfold interp_asm.
-    unfold interp_map. cbn.
+    unfold interp_map. 
     repeat rewrite interp_bind.
     repeat rewrite interp_state_bind.
     repeat rewrite bind_bind.
-    eapply eutt_clo_bind.
+    eapply eutt_bind_eutt.
     { reflexivity. }
     intros.
     rewrite H.
diff --git a/tutorial/AsmCombinators.v b/tutorial/AsmCombinators.v
index d7ebaff0..2f5cc131 100644
--- a/tutorial/AsmCombinators.v
+++ b/tutorial/AsmCombinators.v
@@ -20,7 +20,7 @@
  *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      List
      Strings.String
      Program.Basics
diff --git a/tutorial/AsmOptimization.v b/tutorial/AsmOptimization.v
index 712f3251..0eca8e53 100644
--- a/tutorial/AsmOptimization.v
+++ b/tutorial/AsmOptimization.v
@@ -1,7 +1,7 @@
 (* begin hide *)
-Require Import Psatz.
+From Stdlib Require Import Psatz.
 
-From Coq Require Import
+From Stdlib Require Import
      Lists.List
      Strings.String
      Morphisms
@@ -135,12 +135,11 @@ Proof.
   intros t mem1 mem2 regs1 regs2 H1 H2.
   rewrite interp_asm_bind.
   rewrite <- bind_ret_r at 1.
-  apply (@eutt_clo_bind _ _ _ _ _ _ rel_asm).
+  apply (@eutt_bind_eutt _ _ _ _ _ _ rel_asm).
   { unfold interp_asm.
     unfold rel_asm.
     eapply interp_map_proper; try typeclasses eauto; auto.
     eapply interp_map_proper; try typeclasses eauto; auto.
-    reflexivity.
   }
   intros.
   destruct H as [J1 [J2 J3]]; subst.
@@ -331,7 +330,7 @@ Lemma ph_blk_append_correct {E} {HasExit : Exit -< E} :
     specialize H with (i:=i).
     pose proof (H E tt) as H2.
     do 2 rewrite interp_asm_bind.
-    eapply eutt_clo_bind.
+    eapply eutt_bind_eutt.
     apply H2; auto.
     intros.
     destruct H0 as [J1 [J2 J3]].
@@ -406,9 +405,9 @@ Proof.
   unfold interp_asm, interp_map.
   repeat setoid_rewrite interp_bind.
   repeat rewrite interp_state_bind.
-  apply (@eutt_clo_bind _ _ _ _ _ _ rel_asm).
+  apply (@eutt_bind_eutt _ _ _ _ _ _ rel_asm).
 
-  { apply (@eutt_clo_bind _ _ _ _ _ _ rel_asm).
+  { apply (@eutt_bind_eutt _ _ _ _ _ _ rel_asm).
     -  unfold inr_, Inr_Kleisli, lift_ktree_.
        unfold ret, Monad_itree.
        repeat rewrite interp_ret.
@@ -441,12 +440,12 @@ Proof.
   intros j1 j2 [K1 [K2 ->]]; cbn.
   rewrite !interp_bind, !interp_state_bind, !bind_bind. (* Slow! *)
 
-  apply (@eutt_clo_bind _ _ _ _ _ _ rel_asm);
+  apply (@eutt_bind_eutt _ _ _ _ _ _ rel_asm);
     [|intros ? ? [? [? ->]]]; cbn.
   { refine (peephole_block_correct _ _ _ _ _ _ _ _ _ _ _ _); eauto. }
 
   unfold CategorySub.to_bif, ToBifunctor_ktree_fin.
-  apply (@eutt_clo_bind _ _ _ _ _ _ rel_asm);
+  apply (@eutt_bind_eutt _ _ _ _ _ _ rel_asm);
     [|intros ? ? [? [? ->]]]; cbn.
   {
     rewrite bind_ret_l.
diff --git a/tutorial/CatTheory.v b/tutorial/CatTheory.v
index 8b2ecaa5..af072873 100644
--- a/tutorial/CatTheory.v
+++ b/tutorial/CatTheory.v
@@ -1,5 +1,5 @@
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Morphisms.
 
 From ITree Require Import
diff --git a/tutorial/Fin.v b/tutorial/Fin.v
index 37d7f3c4..75ff461e 100644
--- a/tutorial/Fin.v
+++ b/tutorial/Fin.v
@@ -14,7 +14,7 @@
    [Fun] and [ktree] on finite types (instead of arbitrary types). *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Arith
      Lia.
 
diff --git a/tutorial/Imp.v b/tutorial/Imp.v
index ef832efc..3c0559a0 100644
--- a/tutorial/Imp.v
+++ b/tutorial/Imp.v
@@ -39,7 +39,7 @@
 *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Arith.PeanoNat
      Lists.List
      Strings.String
diff --git a/tutorial/Imp2Asm.v b/tutorial/Imp2Asm.v
index 612f1194..72a7d7a9 100644
--- a/tutorial/Imp2Asm.v
+++ b/tutorial/Imp2Asm.v
@@ -19,7 +19,7 @@
 (* begin hide *)
 From ITreeTutorial Require Import Imp Asm Fin Utils_tutorial AsmCombinators.
 
-From Coq Require Import
+From Stdlib Require Import
      Psatz
      List
      String
diff --git a/tutorial/Imp2AsmCorrectness.v b/tutorial/Imp2AsmCorrectness.v
index 88a97b61..52c1a997 100644
--- a/tutorial/Imp2AsmCorrectness.v
+++ b/tutorial/Imp2AsmCorrectness.v
@@ -54,7 +54,7 @@ SAZ: This needs to be updated.
 (* begin hide *)
 From ITreeTutorial Require Import Imp Asm Utils_tutorial AsmCombinators Imp2Asm Fin KTreeFin.
 
-From Coq Require Import
+From Stdlib Require Import
      Psatz
      Strings.String
      List
@@ -360,7 +360,7 @@ Section Bisimulation.
     repeat intro.
     rewrite interp_asm_bind.
     rewrite interp_imp_bind.
-    eapply eutt_clo_bind.
+    eapply eutt_bind_eutt.
     { eapply H; auto. }
     intros.
     destruct u1 as [? ?].
@@ -395,7 +395,7 @@ Section Bisimulation.
     rewrite interp_state_bind, bind_bind.
     setoid_rewrite interp_state_ret.
     setoid_rewrite bind_ret_l. cbn.
-    apply (@eutt_clo_bind _ _ _ _ _ _ (state_invariant (sum_rel R S))).
+    apply (@eutt_bind_eutt _ _ _ _ _ _ (state_invariant (sum_rel R S))).
     - auto.
     - intros ? ? [? []]; cbn; apply eqit_Ret; constructor; split; auto.
     - constructor; auto.
@@ -547,9 +547,9 @@ Section Linking.
     rewrite bind_ret_l.
     destruct (label_case x); cbn.
     - rewrite !bind_bind. setoid_rewrite bind_ret_l.
-      eapply eutt_clo_bind; try reflexivity. intros; subst.
+      eapply eutt_bind_eutt; try reflexivity. intros; subst.
       rewrite bind_bind.
-      eapply eutt_clo_bind; try reflexivity. intros; subst.
+      eapply eutt_bind_eutt; try reflexivity. intros; subst.
       unfold from_bif, FromBifunctor_ktree_fin; cbn.
       setoid_rewrite bind_ret_l.
       destruct u0.
@@ -561,7 +561,7 @@ Section Linking.
       + rewrite (relabel_asm_correct _ _ _ _). cbn.
         rewrite bind_ret_l.
         setoid_rewrite bind_bind.
-        eapply eutt_clo_bind; try reflexivity.
+        eapply eutt_bind_eutt; try reflexivity.
         intros ? ? [].
         repeat rewrite bind_ret_l.
         apply eqit_Ret.
@@ -634,14 +634,14 @@ Section Correctness.
       rewrite interp_imp_bind.
 
       (* The Induction hypothesis on [e1] relates the first itrees *)
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe1; assumption. }
       (* We obtain new related environments *)
       intros [g_imp' v] [g_asm' [l' []]] HSIM.
       (* The Induction hypothesis on [e2] relates the second itrees *)
       rewrite interp_asm_bind.
       rewrite interp_imp_bind.
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe2.
         eapply sim_rel_Renv; eassumption. }
       (* And we once again get new related environments *)
@@ -662,14 +662,14 @@ Section Correctness.
       rewrite interp_imp_bind.
 
       (* The Induction hypothesis on [e1] relates the first itrees *)
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe1; assumption. }
       (* We obtain new related environments *)
       intros [g_imp' v] [g_asm' [l' []]] HSIM.
       (* The Induction hypothesis on [e2] relates the second itrees *)
       rewrite interp_asm_bind.
       rewrite interp_imp_bind.
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe2.
         eapply sim_rel_Renv; eassumption. }
       (* And we once again get new related environments *)
@@ -690,14 +690,14 @@ Section Correctness.
       rewrite interp_imp_bind.
 
       (* The Induction hypothesis on [e1] relates the first itrees *)
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe1; assumption. }
       (* We obtain new related environments *)
       intros [g_imp' v] [g_asm' [l' []]] HSIM.
       (* The Induction hypothesis on [e2] relates the second itrees *)
       rewrite interp_asm_bind.
       rewrite interp_imp_bind.
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { eapply IHe2.
         eapply sim_rel_Renv; eassumption. }
       (* And we once again get new related environments *)
@@ -731,7 +731,7 @@ Section Correctness.
     (* By correctness of the compilation of expressions,
        we can match the head trees.
      *)
-    eapply eutt_clo_bind.
+    eapply eutt_bind_eutt.
     { eapply compile_expr_correct; eauto. }
 
     (* Once again, we get related environments *)
@@ -782,7 +782,7 @@ Section Correctness.
     rewrite bind_ret_l, tau_eutt.
     rewrite unfold_iter_ktree.
     rewrite !bind_bind.
-    eapply eutt_clo_bind. reflexivity.
+    eapply eutt_bind_eutt. reflexivity.
     intros. subst.
     destruct u2 as [[]|[]].
     2 : { force_right. reflexivity. }
@@ -791,7 +791,7 @@ Section Correctness.
     apply eutt_iter' with (RI := fun _ r => inl tt = r).
     - intros _ _ [].
       rewrite <- bind_ret_r at 1.
-      eapply eutt_clo_bind; try reflexivity.
+      eapply eutt_bind_eutt; try reflexivity.
       intros [|[]] _ []; apply eqit_Ret; auto; constructor; auto.
     - constructor.
   Qed.
@@ -867,7 +867,7 @@ Section Correctness.
       repeat intro.
       rewrite interp_asm_bind.
       rewrite interp_imp_bind.
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { apply compile_expr_correct; auto. }
 
       (* We get in return [sim_rel] related environments *)
@@ -923,7 +923,7 @@ Section Correctness.
       rewrite !interp_asm_bind.
       rewrite !bind_bind.
 
-      eapply eutt_clo_bind.
+      eapply eutt_bind_eutt.
       { apply compile_expr_correct; auto. }
 
       intros [g_imp' v] [g_asm' [l' x]] HSIM.
@@ -952,7 +952,7 @@ Section Correctness.
         rewrite !interp_asm_bind.
         rewrite !interp_imp_bind.
         rewrite !bind_bind.
-        eapply eutt_clo_bind.
+        eapply eutt_bind_eutt.
         { eapply IHs; auto. }
         intros [g_imp'' v''] [g_asm'' [l'' x']] [HSIM' ?].
         force_right; force_left.
diff --git a/tutorial/Introduction.v b/tutorial/Introduction.v
index f76ab318..92d6d24d 100644
--- a/tutorial/Introduction.v
+++ b/tutorial/Introduction.v
@@ -8,7 +8,7 @@
  *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Arith
      Lia
      List.
diff --git a/tutorial/KTreeFin.v b/tutorial/KTreeFin.v
index 93baa46f..de55fee1 100644
--- a/tutorial/KTreeFin.v
+++ b/tutorial/KTreeFin.v
@@ -6,7 +6,7 @@
  *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Setoid
      Morphisms.
 
diff --git a/tutorial/Utils_tutorial.v b/tutorial/Utils_tutorial.v
index c9e0eacb..75e490d2 100644
--- a/tutorial/Utils_tutorial.v
+++ b/tutorial/Utils_tutorial.v
@@ -14,7 +14,7 @@
 *)
 
 (* begin hide *)
-From Coq Require Import
+From Stdlib Require Import
      Ascii
      Strings.String
      List
diff --git a/tutorial/extract-imptest/ImpTest.v b/tutorial/extract-imptest/ImpTest.v
index ce497c0b..1a866a97 100644
--- a/tutorial/extract-imptest/ImpTest.v
+++ b/tutorial/extract-imptest/ImpTest.v
@@ -1,6 +1,6 @@
 From ITree Require Import ITree.
 From ITreeTutorial Require Import Imp.
-From Coq Require Import NArith String.
+From Stdlib Require Import NArith String.
 
 Local Open Scope string_scope.
 
diff --git a/validate-coqproject.sh b/validate-coqproject.sh
new file mode 100755
index 00000000..14ab1cac
--- /dev/null
+++ b/validate-coqproject.sh
@@ -0,0 +1,21 @@
+#!/bin/bash -e
+#
+# Purpose: Checks that files in _CoqProject actually exist
+# 
+
+## Usage: validate-coqproject <_CoqProject-filename>
+## 
+## 
+## author: rab
+## date: Wed Apr 8 15:24:03 EDT 2026
+
+
+NUM_ARGS=1
+
+
+if [[ "$#" -ne "$NUM_ARGS" ]]; then 
+    >&2 echo "Usage: $0 <_CoqProject-filename>"
+    exit 1
+fi
+
+tail -n +3 "$1" | while IFS= read -r f; do [[ -z "$f" ]] || [[ -e "$f" ]] || echo "$f"; done